Sub Test()
Dim city As Variant
Dim city1 As Variant
Dim city2 As Variant
Dim result, result2 As Variant
Dim arrCity As Variant
Dim WkArr As Variant
Dim i As Long
Dim j As Long
Dim R As Long
i = 1
ReDim WkArr(1 To 40 * 40, 1 To 4)
'arrCity = Sheets("Test2").Range("Range")
'
'For Each city In arrCity
' Debug.Print city
'Next
For Each city1 In Range("Range")
'Debug.Print city1 & " " & city2
For Each city2 In Range("Range")
'Debug.Print city2 & " " & city1
On Error Resume Next
WkArr(i, 1) = city1 & " " & city2
WkArr(i, 2) = city2 & " " & city1
WkArr(i, 3) = Application.WorksheetFunction.VLookup(city1, Sheets("Data").Range("A1:PY305"), 314, False)
WkArr(i, 4) = Application.WorksheetFunction.VLookup(city2, Sheets("Data").Range("A1:PY305"), 314, False)
i = i + 1
Next city2
Next city1
With Sheets("Report")
Dim lRow As Long
Dim lCol As Long
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, 1).Offset(lRow, lCol) = WkArr(i, 1)
.Cells(1, 2).Offset(lRow, lCol) = WkArr(i, 2)
.Cells(1, 3).Offset(lRow, lCol) = WkArr(i, 3)
.Cells(1, 4).Offset(lRow, lCol) = WkArr(i, 4)
.Cells(1, 5).Offset(lRow, lCol) = WkArr(i, 5)
End With
R = Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets("Test4")
.Cells(R, 1).Resize(UBound(WkArr, 1), UBound(WkArr, 2)) = WkArr
End With
End Sub
I am trying to create a new block of data for each city with the offset function and where the first entry is in cell A1 and then the next loop should be in Cell A2 etc.
Can anyone help me with this?
With Sheets("Report")
Dim lRow As Long
Dim lCol As Long
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, 1).Offset(lRow, lCol) = WkArr(i, 1)
.Cells(1, 2).Offset(lRow, lCol) = WkArr(i, 2)
.Cells(1, 3).Offset(lRow, lCol) = WkArr(i, 3)
.Cells(1, 4).Offset(lRow, lCol) = WkArr(i, 4)
.Cells(1, 5).Offset(lRow, lCol) = WkArr(i, 5)
End With
This is the part of the code that is not working.
For each loop I would like the data to start in A1, the next loop in C1, the next loop in E1.
Then if possible continue with A25, C25 and E25?