1

Cell C8 and C9 in Worksheet "Google maps" has the pickup and drop-off points. The distance is calculated and shown in C18. Worksheet "Sheet 2" also has Column A with pick up points and Row 1 with the respective drop-off.

I want to write VBA code that will loop through and reference each pick and drop-off in "sheet 2" to "Google maps" then return their respective distances.

Sub Distance()
'
' Distance Macro
' To populate distance
'
' Keyboard Shortcut: Ctrl+Shift+D
'
    Sheets("Google maps").Select
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-6]C[-2]"
    Range("C9").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-8]C[-1]"
    Sheets("Sheet2").Select
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "='Google maps'!R[16]C[1]"
    Range("B3").Select
End Sub
help-info.de
  • 6,695
  • 16
  • 39
  • 41
Loop Dish
  • 11
  • 1
  • How is distance calculated exactly with the two parameters pickup and drop-off points? Also try to avoid using `.Select`, most times it can be avoided. Have a look [here](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). And have a search on how to actually loop trough a range of cells, right now you don't look anything. – JvdV Apr 19 '19 at 09:46

1 Answers1

0

This should do what you need. Make sure you test this on a copy of your spreadsheet before using it.

Sub double_lookup()

    PickUp = ThisWorkbook.Sheets(1).Range("C8").Value
    dropoff = ThisWorkbook.Sheets(1).Range("C9").Value
    distance = ThisWorkbook.Sheets(1).Range("C18").Value

    lastrow = ThisWorkbook.Sheets(2).Cells(ThisWorkbook.Sheets(2).Rows.Count, "A").End(xlUp).Row
    Set Rng = ThisWorkbook.Sheets(2).Range("A1:A" & lastrow)

    xindex = ""
    Count = 1
    For Each cell In Rng
        If cell.Value = PickUp Then
            xindex = Count
            Exit For
        End If

        Count = Count + 1
    Next cell

    yindex = ""
    lastcol = ThisWorkbook.Sheets(2).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    For i = 1 To lastcol
        If ThisWorkbook.Sheets(2).Cells(1, i).Value = dropoff Then
            yindex = i
            Exit For
        End If

    Next i

    If xindex = "" Or yindex = "" Then
        MsgBox ("pickup or dropoff not found in sheet 2")
    Else
        ThisWorkbook.Sheets(2).Cells(xindex, yindex).Value = distance
    End If

End Sub
bm13563
  • 688
  • 5
  • 18