Simplify the following vlookup-CodePudding

I am a beginner in VBA programming. I have recorded the following vlookUp via the macro recorder. How can I shorten and simplify the code for this?

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],oldStockAge!C[-7]:C[1],8,0)"
    Range("J5").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],oldStockAge!C[-8]:C,9,0)"
    Range("D5:J5").Select
    Selection.AutoFill Destination:=Range("D5:J399")
    Range("D5:J399").Select

I would be very grateful if someone could help me.If you need more inforamtion, please come back to me.

CodePudding user response：

Sub OptimizedVlookup()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long, arrVlk

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
    lastR2 = shOld.Range("B" & sh.Rows.Count).End(xlUp).Row
    Set rngB = sh.Range("B5:J" & lastR)
    Set rngBJ = shOld.Range("B5:J" & lastR2)
    
    arrVlk = WorksheetFunction.VlookUp(rngB, rngBJ, 2, False)

    sh.Range("D5:J5").Resize(UBound(arrVlk), 1).Value = arrVlk
End Sub

CodePudding user response：

Here is the other one:

Sub VlookupFormula()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
    lastR2 = shOld.Range("B" & sh.Rows.Count).End(xlUp).Row
    Set rngB = sh.Range("B5:J" & lastR)
    Set rngBJ = shOld.Range("B5:J" & lastR2)

    sh.Range("D5:J" & lastR).Formula = "=VLOOKUP(B5," & rngBJ.Address(external:=True) & ",2,0)"
End Sub

CodePudding user response：

Please, try the next fast function able to place the Vlookup result for all involved range in an array and drop its content at once. I cannot understand what's happening before J5 cell (D5:I5)... The code returns the VLookup result in column J:J, starting from J5:

Sub OptimizedVlookup()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long, arrVlk

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B5:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    
    arrVlk = WorksheetFunction.VLookup(rngB, rngBJ, 9, False)

    sh.Range("J5").Resize(UBound(arrVlk), 1).Value = arrVlk
End Sub

A different version:

Sub OptimizedVlookupMoreColsVersion2()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, iRow As Long, i As Long

   iRow = 5
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B" & iRow & ":B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    For i = iRow To lastR
        arrVlk = Application.IfError(Evaluate("=VLOOKUP(B" & i & "," & rngBJ.Address(external:=True) & ",{3,4,5,6,7,8,9},FALSE)"), "N/A")
        If TypeName(arrVlk) = "String" Then
             sh.cells(i, "D").Resize(1, 7).Value = "N/A"
        Else
            sh.cells(i, "D").Resize(1, UBound(arrVlk)).Value = arrVlk
        End If
    Next i
End Sub

In order to write the VLookup formula, not its result, please try the next way:

Sub VlookupFormula()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B2:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)

    sh.Range("J2:J" & lastR).Formula = "=VLOOKUP(B2," & rngBJ.Address(external:=True) & ",9,0)" 
End Sub

Edited:

If I correctly understood your need, the next code will place formulas able to return from all correspondent columns of the range "D:J":

Sub OptimizedVlookupMoreCols()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, iRow As Long, i As Long

   iRow = 5 'the row where from the data will be returned
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B" & iRow & ":B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    For i = 3 To 9
        arrVlk = WorksheetFunction.VLookup(rngB, rngBJ, i, False)
        sh.cells(iRow, i   1).Resize(UBound(arrVlk), 1).Value = arrVlk
    Next i
End Sub

And the next one will write formulas to return the same data:

Sub VlookupFormulaMoreCols() 
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, i As Long, iRow As Long

   iRow = 5
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B2:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    'create the first range (row 5) Vlookup formulas:
    For i = 3 To 9
        sh.cells(iRow, i   1).Formula = "=VLOOKUP(B2," & rngBJ.Address(external:=True) & "," & i & ",0)"
    Next i
    sh.Range("D" & iRow, "J" & iRow).AutoFill destination:=sh.Range("D" & iRow, "J" & lastR)
End Sub

Please, send some feedback after testing it/them.