Thursday, October 3, 2013

VBA Sample Code for Two Dimensional Array

Option Explicit
Dim daterng As Range, otherrng As Range, i As Integer, j As Integer, tempCounter As Integer, tempcounternew As Integer
Dim tempcounternew1 As Integer, tempcounternew2 As Integer, tempcounternew3 As Integer
Dim myArray()
Sub realignmentofreport()
Set daterng = ThisWorkbook.Sheets(1).Range("B10:B13")
Set otherrng = ThisWorkbook.Sheets(1).Range("B3:B6")
tempCounter = 0
tempcounternew = 0
tempcounternew1 = 0
tempcounternew2 = 0
tempcounternew3 = 0
On Error Resume Next
    ReDim myArray(1 To daterng.Rows.Count * 5, 1 To otherrng.Rows.Count)
    For i = 1 To UBound(myArray())
   
        tempCounter = tempCounter + 1
       
              
        Select Case (tempCounter < 6)
            Case True
               
                tempcounternew = tempcounternew + 2
                myArray(i, 1) = ThisWorkbook.Sheets(1).Range("B10")
                myArray(i, 2) = ThisWorkbook.Sheets(1).Range("B10").Offset(0, tempcounternew)
                myArray(i, 3) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B10").Offset(0, tempcounternew - 1), [lookuprng], 2, 0)
                myArray(i, 4) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B10").Offset(0, tempcounternew - 1), [lookuprng], 3, 0)
            Case Else
                Select Case (tempCounter < 11) And (tempCounter > 5)
                Case True
                    tempcounternew1 = tempcounternew1 + 2
                   
                    myArray(i, 1) = ThisWorkbook.Sheets(1).Range("B11")
                    myArray(i, 2) = ThisWorkbook.Sheets(1).Range("B11").Offset(0, tempcounternew1)
                    myArray(i, 3) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B11").Offset(0, tempcounternew1 - 1), [lookuprng], 2, 0)
                    myArray(i, 4) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B11").Offset(0, tempcounternew1 - 1), [lookuprng], 3, 0)
                 Case Else
                    Select Case (tempCounter < 16) And (tempCounter > 10)
                        Case True
                            tempcounternew2 = tempcounternew2 + 2
                           
                            myArray(i, 1) = ThisWorkbook.Sheets(1).Range("B12")
                            myArray(i, 2) = ThisWorkbook.Sheets(1).Range("B12").Offset(0, tempcounternew2)
                            myArray(i, 3) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B12").Offset(0, tempcounternew2 - 1), [lookuprng], 2, 0)
                            myArray(i, 4) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B12").Offset(0, tempcounternew2 - 1), [lookuprng], 3, 0)
                   
                        Case Else
                            Select Case (tempCounter < 21) And (tempCounter > 15)
                                Case True
                                    tempcounternew3 = tempcounternew3 + 2
                                   
                                    myArray(i, 1) = ThisWorkbook.Sheets(1).Range("B13")
                                    myArray(i, 2) = ThisWorkbook.Sheets(1).Range("B13").Offset(0, tempcounternew3)
                                    myArray(i, 3) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B13").Offset(0, tempcounternew3 - 1), [lookuprng], 2, 0)
                                    myArray(i, 4) = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(1).Range("B13").Offset(0, tempcounternew3 - 1), [lookuprng], 3, 0)
                            End Select
                    End Select
                End Select
        End Select
       
       
  Next
    Sheets(1).Range("H19").Resize(tempCounter, UBound(myArray, 2)) = myArray
End Sub
 https://drive.google.com/file/d/0B23eJ2xd9ODyQTY0blFYRk9McVU/edit?usp=sharing

No comments:

Post a Comment