CODEWITHSUNDEEP
vbaexcel
Sally
Sally

Reputation: 1

Select next criteria after finding matches

I have a list of cities as a search criteria and I'm looking to pull zipcodes of the corresponding cities.

Column A holds all the cities, Column B is the list of zipcodes, and column D is the criteria column where the user will enter the name of the cities to search. After the search, the corresponding zipcodes will be listed on column E. I have the following in VBA which only grabs the search criteria from D1 but I was wondering if there was a way to search the criteria on D2 after the initial search and go down row by row until there is a blank row on column D.

Sub Test2()
    Dim Find As String
    Dim finalrow As Integer
    Dim i As Integer

    Find = Sheets("Test").Range("D1").Value
    finalrow = Sheets("Test").Range("A10000").End(xlUp).Row

    For i = 2 To finalrow
        If Cells(i, 1) = Find Then
            Range(Cells(i, 2), Cells(i, 3)).Copy
            Range("E10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        End If
    Next i
End Sub

Upvotes: 0

Views: 85

Answers (3)

E. A. Bagby
E. A. Bagby

Reputation: 930

Try Below. You can use IsEmpty to determine the end of the list, assuming the cell after the last list item is actually empty, and there are no empty cells in column A that are empty in the middle of the list.

Sub Test2()

Dim rRngFind As Range
Dim rRngCity As Range
Dim rRngResult As Range
Dim i As Integer

'Set Input cell for Find, I chose D2
Set rRngFind = Sheets("Test").Range("D2")

'Set first city search row, presumably not the top row since you will have headings and such
Set rRngCity = Sheets("Test").Range("A2")

'Set Cell for first result, I chose E2
Set rTngResult = Sheets("Test").Range("E2")


Do Until IsEmpty(rRngCity)

    If rRngFind.Value = rRngCity.Value Then
        rTngResult.Value = Sheets("Test").Range("B" & rRngCity.Row).Value
        i = rTngResult.Row + 1
        Set rTngResult = Sheets("Test").Range("E" & i)
    End If
    'increment the row
    i = rRngCity.Row + 1
    Set rRngCity = Sheets("Test").Range("A" & i)

Loop

End Sub

Upvotes: 0

user4039065
user4039065

Reputation:

I understand that you were seeking a VBA based solution but a standard formula can accomplish the same thing.

      Index First Second Third

The standard formula in E2 is,

=IFERROR(INDEX(B$2:B$999, SMALL(INDEX(ROW($1:$998)+(A$2:A$999<>D$2)*1E+99, , ), ROW(1:1))), "")

Fill down a sufficient number of rows to catch all possible matches. Typing a city into D2 will instantly return the full set of matching zips. When it runs out of matches, it will simply return an empty string (hence the need to fill down enough rows to accommodate the largest set of matches). I have seen COUNTA used to compare the number of matches in column A with the number of matches in column E and show red if the formula has not been filled down sufficiently to catch all possibles.

FWIW, if I was planning a VBA based solution I would use WorksheetFunction.Match rather than loop through each row,

Upvotes: 1

Maciej Los
Maciej Los

Reputation: 8591

Try this:

Dim wsh as Worksheet
Dim i As Integer

Set wsh = ThisWorkbook.Worksheets("Sheet1")
i = 0
Do While wsh.Range("D1").Offset(ColumnOffset:=i)<>""
   'your code
    i=i+1
Loop

Always use code within context. Why? Simple Range("A1") refers to ActiveSheet. Check this:

Sub CodeContext
    Sheets(1).Activate
    Range("A1") = 1
    Sheets(2).Activate
    Range("A1") = 2
End Sub

Upvotes: 0

Related Questions