VLookup simulation: copying data from one sheet to another
This was an interesting challenge - improve performance of arrays

But first, to cover the basics:


Option Explicit is missing - this statement fixes the most basic syntax issues
The range references are good overall, but lengthy and repetitive


The only one missing is on the 6th line Rows(... which deletes rows from active sheet

Indentation is inconsistent, and missing at the first level (Sub - End Sub)
The first loop doesn't work properly, and every execution it deletes the last row with data


For 10 rows i=11, but the .End(xlUp).Row is 10, and becomes Rows("11:10").Delete




'Delete Rows with no content
 Dim i As Integer
 i = 0
 Do
   i = i + 1
 Loop While Range("A" &amp; i) &lt;&gt; ""
 Rows(i &amp; ":" &amp; Worksheets("All Time SMS Dump").Range("A" &amp; Rows.Count).End(xlUp).Row).Delete (xlShiftUp)






In all For loops you have For i = 2 To... &amp; For j = 2 To... then compare i - 1 = j - 1


Assigning .Range("D2:D" &amp; LastRowSF) to array, first item in the array is D2 (index 1)

The main Sub defaults to public, but the Public keyword should be explicit


Most subs and functions should be made Private to modules unless they are utilities





On to Performance

I'm providing 3 versions for comparison (v1 - is your version with three For loops)


v2 - Code cleanup and optimization (three For loops)
v3 - Improve performance - change algorithm (one For loop)
v4 - Arrays and a dictionary (one For loop)




v2 - Code cleanup and optimization (three For loops)

Public Sub VinLookUpArr1()
    Dim wsAT As Worksheet, wsSF As Worksheet, valAT As Variant, valSF As Variant
    Dim lrAT As Long, lrSF As Long, vinAT As Variant, vinSF As Variant, t As Double

    t = Timer
    Set wsAT = ThisWorkbook.Worksheets("All Time SMS Dump")
    Set wsSF = ThisWorkbook.Worksheets("Salesforce Dump")

    lrAT = wsAT.Range("A" &amp; Rows.Count).End(xlUp).Row
    lrSF = wsSF.Range("A" &amp; Rows.Count).End(xlUp).Row

    vinAT = wsAT.Range("A2:A" &amp; lrAT)
    vinSF = wsSF.Range("C2:C" &amp; lrSF)

    wsAT.Rows(wsAT.Rows(1).End(xlDown).Row + 1 &amp; ":" &amp; lrAT + 1).Delete xlShiftUp
    wsSF.Rows(wsSF.Rows(1).End(xlDown).Row + 1 &amp; ":" &amp; lrSF + 1).Delete xlShiftUp
    wsAT.Columns("G:H").NumberFormat = "General"

    valAT = wsAT.Range("G2:G" &amp; lrAT)
    valSF = wsSF.Range("D2:D" &amp; lrSF)
    wsAT.Range("G2:G" &amp; lrAT) = DoLookUpArr1(vinAT, vinSF, valAT, valSF)
    valAT = wsAT.Range("H2:H" &amp; lrAT)
    valSF = wsSF.Range("E2:E" &amp; lrSF)
    wsAT.Range("H2:H" &amp; lrAT) = DoLookUpArr1(vinAT, vinSF, valAT, valSF)
    valAT = wsAT.Range("I2:I" &amp; lrAT)
    valSF = wsSF.Range("F2:F" &amp; lrSF)
    wsAT.Range("I2:I" &amp; lrAT) = DoLookUpArr1(vinAT, vinSF, valAT, valSF)
    Debug.Print "lrAT: " &amp; lrAT &amp; "; lrSF: " &amp; lrSF &amp; "; Time: " &amp; Format(Timer - t, "0.000")
End Sub




Private Function DoLookUpArr1(ByVal vinAT As Variant, ByVal vinSF As Variant, _
                              ByVal valAT As Variant, ByVal valSF As Variant) As Variant

    Dim rAT As Long, rSF As Long, lrSF As Long

    lrSF = UBound(valSF)
    For rAT = 1 To UBound(valAT)
        For rSF = 1 To lrSF
            If vinAT(rAT, 1) = vinSF(rSF, 1) Then
                valAT(rAT, 1) = valSF(rSF, 1)
                Exit For
            End If
        Next rSF
    Next rAT
    DoLookUpArr1 = valAT
End Function




v3 - Improve performance - change algorithm (one For loop)


This loops only once for all vLookups:




Public Sub VinLookUpArr2()
    Dim wsAT As Worksheet, wsSF As Worksheet, urAT As Variant, urSF As Variant
    Dim lrAT As Long, lrSF As Long, lcAT As Long, lcSF As Long, t As Double
    Dim rAT As Long, rSF As Long, map(1 To 2, 1 To 4) As Byte, i As Long

    t = Timer
    Set wsAT = ThisWorkbook.Worksheets("All Time SMS Dump")
    Set wsSF = ThisWorkbook.Worksheets("Salesforce Dump")

    map(1, 1) = 1:    map(2, 1) = 3        'A to C (VINs)
    map(1, 2) = 7:    map(2, 2) = 4        'G to D
    map(1, 3) = 8:    map(2, 3) = 5        'H to E
    map(1, 4) = 9:    map(2, 4) = 6        'I to F

    lrAT = wsAT.Cells(Rows.Count, 1).End(xlUp).Row              'lr = last row
    lrSF = wsSF.Cells(Rows.Count, 1).End(xlUp).Row
    lcAT = wsAT.Cells(1, Columns.Count).End(xlToLeft).Column    'lc = last col
    lcSF = wsSF.Cells(1, Columns.Count).End(xlToLeft).Column

    urAT = wsAT.Range(wsAT.Cells(1), wsAT.Cells(lrAT, lcAT))    'ur = used range
    urSF = wsSF.Range(wsSF.Cells(1), wsSF.Cells(lrSF, lcSF))

    For rAT = 2 To lrAT
        For rSF = 2 To lrSF
            If urAT(rAT, map(1, 1)) = urSF(rSF, map(2, 1)) Then
                For i = 2 To 4
                    urAT(rAT, map(1, i)) = urSF(rSF, map(2, i))
                Next
                Exit For
            End If
        Next
    Next
    wsAT.Range(wsAT.Cells(1), wsAT.Cells(lrAT, lcAT)) = urAT
    Debug.Print "lrAT: " &amp; lrAT &amp; "; lrSF: " &amp; lrSF &amp; "; Time: " &amp; Format(Timer - t, "0.000")
End Sub




v4 - Arrays and a dictionary (one For loop)


The most important improvement is gained by the .Exists() method of the dictionary




Public Sub VinLookUpDictionary()
    Dim wsAT As Worksheet, wsSF As Worksheet, urAT As Variant, urSF As Variant
    Dim lrAT As Long, lrSF As Long, lcAT As Long, lcSF As Long, t As Double
    Dim rAT As Long, rSF As Long, map(1 To 2, 1 To 4) As Byte, i As Long, d As Dictionary
    t = Timer
    Set d = New Dictionary
    Set wsAT = ThisWorkbook.Worksheets("All Time SMS Dump")
    Set wsSF = ThisWorkbook.Worksheets("Salesforce Dump")
    map(1, 1) = 1:    map(2, 1) = 3        'A to C (VINs)
    map(1, 2) = 7:    map(2, 2) = 4        'G to D
    map(1, 3) = 8:    map(2, 3) = 5        'H to E
    map(1, 4) = 9:    map(2, 4) = 6        'I to F
    lrAT = wsAT.Cells(Rows.Count, 1).End(xlUp).Row              'lr = last row
    lrSF = wsSF.Cells(Rows.Count, 1).End(xlUp).Row
    lcAT = wsAT.Cells(1, Columns.Count).End(xlToLeft).Column    'lc = last col
    lcSF = wsSF.Cells(1, Columns.Count).End(xlToLeft).Column
    urAT = wsAT.Range(wsAT.Cells(1), wsAT.Cells(lrAT, lcAT))    'ur = used range
    urSF = wsSF.Range(wsSF.Cells(1), wsSF.Cells(lrSF, lcSF))
    For rSF = 2 To lrSF
        d(urSF(rSF, map(2, 1))) = vbNullString
    Next
    For rAT = 2 To lrAT
        For rSF = 2 To lrSF
            If d.Exists(urAT(rAT, map(1, 1))) Then
                For i = 2 To 4
                    urAT(rAT, map(1, i)) = urSF(rSF, map(2, i))
                Next
                Exit For
            End If
        Next
    Next
    wsAT.Range(wsAT.Cells(1), wsAT.Cells(lrAT, lcAT)) = urAT
    Debug.Print "lrAT: " &amp; lrAT &amp; "; lrSF: " &amp; lrSF &amp; "; Time: " &amp; Format(Timer - t, "0.000")
End Sub




Results

Total Rows on sheet "All Time SMS Dump": 20,001
Total Rows on sheet "Salesforce Dump":   20,001



v1 = Time: 53.469 sec (arrays - 3 loops)
v2 = Time: 54.676 sec (arrays - 3 loops)
v3 = Time: 20.637 sec (arrays - 1 loop)
v4 = Time:  0.484 sec (arrays &amp; dictionary - 1 loop)