PDA

View Full Version : [SOLVED] Help defining and building an array and using VLOOKUP



tx7399
05-13-2015, 06:35 PM
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 13374

Paul_Hossler
05-13-2015, 06:50 PM
Are you looking for the VBA equivalent for the worksheet formula?

tx7399
05-13-2015, 06:58 PM
I would like to see the vba using application.worksheetfunction....

mperrah
05-13-2015, 07:26 PM
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
05-13-2015, 07:37 PM
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
05-13-2015, 09:05 PM
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
05-14-2015, 01:22 AM
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
05-14-2015, 01:54 AM
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
05-14-2015, 06:23 AM
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
05-14-2015, 11:14 AM
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
05-14-2015, 04:14 PM
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