Help defining and building an array and using VLOOKUP

[tx7399]

Hi everyone,

Noobie struggling with the following:


Trying to populate an array and then use VLookup to update another sheet.

First value to be entered into the array is found by moving down column K to first blank cell and then using offset to move one cell left . That cell value is first element of array.

Move to next blank in col K, apply offset. That cell value is second element of array.

For each array element I would like to use VLOOKUP to lookup the array element in a list found on Sheet2 of same workbook. The elements should be found in sheet2 range A2:2617, if not found, it would be nice to return “not found”.
The value I need returned and written to the corresponding blank cell in colK of sheet1 is in col C of sheet2 (the County Name).

I am trying to fill in missing county name by looking up the zip code.

All help is appreciated.


Test data is attached as Book1 Book1.xlsx

[Paul_Hossler]

Are you looking for the VBA equivalent for the worksheet formula?

[tx7399]

I would like to see the vba using application.worksheetfunction....

[mperrah]

you can get to the result without the function.
After building the array we can compare each element to the list on sheet 2 and display the offset for each match and "not found" for no matches

[tx7399]

How do I build the array of just values found in the offset cell from the blank cells in column K? And then how do I process each array element to get the County Name from sheet2?

[mperrah]

Bear with me, I'm on my surfceRT which does not support VBA I'll be able to test in morning
Un tested

Sub buildArrayVlookup()
Dim x, i, c, lr, lr111 as long
Dim aZip as variant
Dim aMatch

lr = cells(rows.count, 11).end(xlup).row
i =1
   For x = 1 to lr
      If cells(x, 11).value = "" then
         Cells(i, 111).value = cells(x, 10).value
         i = i + 1
      End if
   Next x

lr111 = cells(rows.count, 111).end(xlup).row
 rdim aZip = 1 to lr111
      For c = 1 to lr111
        aZip(c) = cells(c, 111).value
      Next c
   For aMatch = LBound(aZip) to UBound(aZip)
      For z = 1 to lr
         If aZip(aMatch) = sheet2.cells(z, 2) then
            sheet1.cells(aMatch, 112).value = sheet2(z, 3).value
         else
           sheet1.cells(aMatch, 112).value = "Match not found"
        End if
     Next z
   next aMatch
End sub

I think this will build the array of county values with a missing zip and list it in column 111
Then find the zip firm sheet2 and put it next to the county in column 112
Just need the last step of matching the values to the array source column K sheet1,
I need my pc to test further.
Hope this helps or gives some illumination
-mark

[Yongle]

A different approach
- using SpecialCells property to determine range of blank cells and
- VLookup instead of Match with error handling to deal with items not found.
- variable captures list of not found items

To write "Zip Not Found" to the cell, remove apostrophe on line

'c.Value = "ZIP not found"

Otherwise delete line.

Sub A_yon()
'declare variables
Dim MyRange, BlankRange, LookupRange, LastRowA, LastRowB, MyArray(), BlankCells, i, a, NotFound
'set range lookup area
With Sheets("Sheet2")
    LastRowB = .Range("B2").End(xlDown).Row
    Set LookupRange = .Range("B2:C" & LastRowB)
End With
'set range for blank cells
With Sheets("Sheet1")
    LastRowA = .Range("J2").End(xlDown).Row
    Set MyRange = .Range("K2:K" & LastRowA)
    Set BlankRange = MyRange.Cells.SpecialCells(xlCellTypeBlanks)
    BlankCells = WorksheetFunction.CountBlank(MyRange)
    ReDim MyArray(BlankCells)
'create array and look up missing values
    For Each c In BlankRange
        a = a + 1
        MyArray(a) = c.Offset(0, -1).Value
        On Error Resume Next
        c.Value = Application.WorksheetFunction.VLookup(MyArray(a), LookupRange, 2, False)
            If Err.Number <> 0 Then
                'c.Value = "ZIP not found"
                NotFound = NotFound & vbNewLine & MyArray(a)
            End If
       Next c
End With

MsgBox "List of Zips not found =" & vbNewLine & NotFound
End Sub

[Yongle]

And this does the same job
- intermediate variables removed
- without using an array

Sub B_yon()
'declare variables
Dim BlankRange, LookupRange, c, NotFound
'set range lookup area
    Set LookupRange = Sheets("Sheet2").Range("B2:C" & Sheets("Sheet2").Range("B2").End(xlDown).Row)
'set range for blank cells
With Sheets("Sheet1")
    Set BlankRange = .Range("K2:K" & .Range("J2").End(xlDown).Row).Cells.SpecialCells(xlCellTypeBlanks)
'look up missing values
    For Each c In BlankRange
        On Error Resume Next
        c.Value = Application.WorksheetFunction.VLookup(c.Offset(0, -1).Value, LookupRange, 2, False)
            If Err.Number <> 0 Then
                'c.Value = "ZIP not found"
                NotFound = NotFound & vbNewLine & c.Offset(0, -1).Value
            End If
       Next c
End With


MsgBox "List of Zips not found =" & vbNewLine & NotFound
End Sub

[Paul_Hossler]

I'm getting confused about the changing requirements

Did you want the VBA use of VLookup to fill in data to the worksheet, or do you want to return some kind of array with something in it, or exactly something else?


This uses VLookup in a module to fill in any missing counties on Sheet1 using the 'data base' on Sheet2

Option Explicit
Sub FillInCounty()
    Dim rZipAndCounties As Range, rData As Range, rZipsWithoutCounty As Range, rBlankCounty As Range
    
    Application.ScreenUpdating = False
    
    'change to suit but a single cell will do to start to make it easy
    Set rData = Worksheets("Sheet2").Range("A1")
    Set rData = rData.CurrentRegion.EntireColumn
    Set rData = Intersect(rData, rData.Parent.UsedRange)
    Set rData = rData.Cells(1, 2).Resize(rData.Rows.Count, rData.Columns.Count - 1)
    MsgBox rData.Address(1, 1, 1, 1)
    
    Set rZipAndCounties = Worksheets("Sheet1").Range("J1")
    Set rZipAndCounties = rZipAndCounties.CurrentRegion
    MsgBox rZipAndCounties.Address(1, 1, 1, 1)
    
    
    'now  save any missing cities
    Set rZipsWithoutCounty = Nothing
    On Error Resume Next
    Set rZipsWithoutCounty = rZipAndCounties.Columns(2).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    'if no blanks then exit
    If rZipsWithoutCounty Is Nothing Then Exit Sub
    'MsgBox rZipsWithoutCounty.Address(1, 1, 1, 1)
    For Each rBlankCounty In rZipsWithoutCounty.Cells
        On Error Resume Next
        rBlankCounty.Value = Application.WorksheetFunction.VLookup(rBlankCounty.Offset(0, -1).Value, rData, 2, False)
        On Error GoTo 0
    Next
    Application.ScreenUpdating = True

End Sub

[mperrah]

this works too

Sub buildArrayVlookup()
    Dim x, i, c, lr, lr13 As Long
    Dim aZip As Variant
    Dim aMatch
     
    lr1 = Cells(Rows.Count, 11).End(xlUp).Row
    i = 1
    For x = 1 To lr1
        If Cells(x, 11).Value = "" Then
            Cells(i, 13).Value = Cells(x, 10).Value
            i = i + 1
        End If
    Next x
     
    lr2 = Cells(Rows.Count, 13).End(xlUp).Row
    ReDim aZip(1 To lr2)
    
    For c = 1 To lr2
        aZip(c) = Cells(c, 13).Value
    Next c
    
    lr3 = Sheets(2).Cells(Rows.Count, 3).End(xlUp).Row
    For aMatch = LBound(aZip) To UBound(aZip)
        For Z = 1 To lr3
            If aZip(aMatch) = Sheet2.Cells(Z, 2) Then
                Sheets(1).Cells(aMatch, 14).Value = Sheets(2).Cells(Z, 3).Value
            End If
        Next Z
    Next aMatch
    
    For x = 2 To lr1
        For c = 1 To lr2
            If Cells(c, 13).Value = Cells(x, 10).Value Then
                Cells(x, 11).Value = Cells(c, 14).Value
            End If
        Next c
    Next x
    Range("M:N").ClearContents
End Sub

[tx7399]

Thanks to everyone for great responses. Three COMPLETE SOLUTIONS; all meeting my needs! I also appreciate the commentary which made it much easier for me to understand.

Regards,
Paul