Automated Vlookup inVBA

Sometimes we need to use vlookup for more than 1000 rows in a single sheet for discrete columns. Today I'll publish automated vlookup VBA code and it'll take care of all rows even if next row is blank .

Sub autovlookup()
    Dim lookupcell, sheetname, tempcelladdress As String
    Dim cntrow, tempcount As Long
    sheetname = ActiveSheet.Name
    cntrow = Application.WorksheetFunction.CountA(Range("A:A"))
    tempcount = 1
   
   
    On Error Resume Next
    Do
        ActiveCell.Offset(1, 0).Select
        tempcelladdress = Range(ActiveCell.Address).Offset(0, -1).Address
       
   
    If Len(tempcelladdress) = 4 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 1)
    ElseIf Len(tempcelladdress) = 5 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 2)
    ElseIf Len(tempcelladdress) = 6 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 3)
    ElseIf Len(tempcelladdress) = 7 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 4)
    ElseIf Len(tempcelladdress) = 8 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 5)
    End If
    If Range(ActiveCell.Address).Offset(0, -1).Value <> "" Then
    tempcount = tempcount + 1
    ActiveCell.Formula = "=vlookup(" & lookupcell & ",'SalesData'!D1:F3457,2,0)"
    End If
   
    Loop Until tempcount = cntrow
End Sub