Find blank cells in column and put in VLookup formula, but only if there is a value in another cell in a different column

[tropics123]

Hi, thank you in advance for any help on this!

Here's what I'm trying to accomplish:

• On Sheet1, look for blank cells in columns O, Q, Z, AC, and put in a Vlookup formula (referencing sheet2).
• But only put in the Vlookup formula if there is a value (name) in column B (in the same row and on the same Sheet1).

The first blank cell in column O, Q, Z, AC is random because I get different data daily.
Here's what I've pieced together for column O, but it doesn't work. it doesn't work meaning the Vlookup formula is not inserted in the blank cells in the column O. For example, I want to find all blank cells in column O and put in the Vlookup formula only if there's a name in column B on the same row. If cell O3 is blank and cell B3 has a name then insert the Vlookup formula. if cell O4 is blank but there's nothing in B3, then don't put in the Vlookup formula. If O5 is not blank and then skip and look for the next blank cell in column O. I want to do this for columns O, Q, Z, AC and put in 4 different Vlookup formulas.
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub BegBalance()
'
' BegBalance Macro
' Adding formula to pull in beginning balance

Dim lFirstBlank As Long, lLastRow As Long
Dim rRange As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim srchres As Variant

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
lFirstBlank = _
Range("O2:O" & lLastRow).SpecialCells(xlCellTypeBlanks).Cells(1, 1).Row

Set rRange = Range("O" & lFirstBlank & ":O" & _
lLastRow).SpecialCells(xlCellTypeBlanks)

On Error Resume Next
srchres = Application.WorksheetFunction.VLookup(ws1.Range("B2"), ws2.Range("B:H"), 3, False)
On Error GoTo 0
If (IsEmpty(srchres)) Then
ws1.Range("O2").Formula = CVErr(Error)
Else
ws2.Range("O2").Value = srchres
End If</code>

 

[steve the fish]

See if this works:

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lLastRow As Long, i As Long
Dim arr As Variant

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

With ws1
    lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr = .Range("B1:O" & lLastRow)
    For i = LBound(arr) To UBound(arr)
        If Len(arr(i, 14)) = 0 Then
            If Len(arr(i, 1)) > 0 Then
                arr(i, 14) = Application.VLookup(arr(i, 1), ws2.Range("B:H"), 3, False)
            End If
        End If
    Next
    .Range("O1:O" & lLastRow) = Application.Index(arr, 0, 14)
End With