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
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