I have 1000 excel rows of values, some are duplicates, and I want to find what column number those values exist in on another tab in VBA

Question

I have a workbook with two tabs. My first tab has rows added to it by various people everyday, and one cell entered is a city name. Everybody enters this city name different, for example, New York could be entered as NYC, NY, NwYrk, New York, NewYkCty, etc. On a second tab, I have created a 'lookup' database where Row 2 is the proper way to spell the City name, and every time I see a new iteration of how somebody spells it I copy their version below it. I am looking for a formula or a way in VBA to be able to iterate through the thousands of rows I can get within a month against the thousands of city names I have in my mini-database and provide to me which column number the match is found in, so I can run offset formulas from it. One more thing to note, prior day locations can be edited so I will need to have this always updating if a change has been made to the city name.

I have tried this code below, but it takes 5-8 minutes to run through every single cell and continues to take longer as more cells get added.

            With Sheets("Billings").Range("b1")
                Set columnLocationList = Range(.Offset(1, 0), .End(xlDown))
            End With

            For Each columnLocations In columnLocationList
                For Each locations In Sheets("Database Names").UsedRange
                    If columnLocations = locations Then
                        columnLocations.Offset(0, 1).Value = locations.Column
                        GoTo nextBill
                    End If
                Next locations
nextBill:
            Next columnLocations

Tab: Billings

ID	City Name	Column Number
1	NYC	3
2	LAX	2

Tab: Database Names

City Names	Los Angeles	New York
Entered Names	LA	NC
	LAX	NYC

Have you thought adding data validation to the row that people have access ? https://support.microsoft.com/en-us/office/apply-data-validation-to-cells-29fecbcc-d1b9-42c1-9d76-eff3ce5f7249 — Kostas Nitaf, Jul 26 '23 at 16:45
Unfortunately data validation won't work as these rows are technically being copied from another workbook so I would be the one needing to be making these edits anyways. — Geofex, Jul 26 '23 at 16:58
i wish this would work, but it won't work either because the city name can change, every day i copy the same data into the sheet incase there is a change in the city name — Geofex, Jul 26 '23 at 17:55
Three thoughts: (1) assuming that the user supplied values are fairly consistent in the first letter they use for a given city (such as "N" or "n" for New York and "L" or "l" for Los Angeles) you could limit the columns searched in your "database" - at the moment you are searching columns which have no potential for a match because they begin with the wrong letter. (2) How do you identify new user supplied values? (3) Get a bigger machine. — DMM, Jul 26 '23 at 18:29
As far as I can tell, For Each searches a range in row order. Column order searching would be better, particularly if you can narrow down the columns that need to be searched. Even better if you can periodically order the values in each column in order of frequency of use. — DMM, Jul 26 '23 at 18:53
I like this creative solution, would definitely require some major code edits. agreed that i need to find a way to shorten the columns it searches. i was hoping there could be some combo of premade Excel/VBA formulas I could use that would solve this issue. eg. if the location is found through a vlookup, return the column location of the cell rather than a true/false. to answer your question in (2), i have a user form that finds all the locations that aren't in the database and gives the user the ability to choose which header the location needs to fall under — Geofex, Jul 26 '23 at 19:01

VBasic2008 · Answer 1 · 2023-07-26T21:44:02.373

Populate Column Indexes

Main

Sub PopulateColumnIndexes()
    
    Const PROC_TITLE As String = "Populate Column Indexes"
    Const WORKSHEET_NAME As String = "Billings"
    Const FIRST_ROW As Long = 2
    Const SRC_COLUMN As Long = 2
    Const DST_COLUMN As Long = 3
    Const NOT_FOUND_VALUE As Variant = Empty
    Const MESSAGE_YES As String = "Column indexes populated."
    Const MESSAGE_NO As String = "Couldn't find the following locations:"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(WORKSHEET_NAME)
    Dim RowOffset As Long: RowOffset = FIRST_ROW - 1
    
    Dim srg As Range, drg As Range
    
    With ws.UsedRange
        With .Resize(.Rows.Count - RowOffset).Offset(RowOffset)
            Set srg = .Columns(SRC_COLUMN)
            Set drg = .Columns(DST_COLUMN)
        End With
    End With
    
    Dim Data(): Data = srg.Value
    Dim Locations As Object: Set Locations = LocationsToDictionary
    Dim NoLocs As Object: Set NoLocs = CreateObject("Scripting.Dictionary")
    NoLocs.CompareMode = vbTextCompare
    
    Dim r As Long, rStr As String, sAddress As String, IsFound As Boolean
    
    For r = 1 To UBound(Data, 1)
        rStr = CStr(Data(r, 1))
        If Len(rStr) > 0 Then
            If Locations.Exists(rStr) Then IsFound = True
        End If
        If IsFound Then
            IsFound = False
            Data(r, 1) = Locations(rStr)
        Else
            Data(r, 1) = NOT_FOUND_VALUE
            sAddress = srg.Cells(r).Address(0, 0)
            If NoLocs.Exists(rStr) Then
                NoLocs(rStr) = NoLocs(rStr) & ", " & sAddress
            Else
                NoLocs(rStr) = """" & rStr & """ in " & sAddress
            End If
        End If
    Next r
    
    drg.Value = Data
    
    If NoLocs.Count = 0 Then
        MsgBox MESSAGE_YES, vbInformation, PROC_TITLE
    Else
        MsgBox MESSAGE_NO & vbLf & vbLf & Join(NoLocs.Items, vbLf), _
            vbExclamation, PROC_TITLE
    End If

End Sub

Help

Function LocationsToDictionary() As Object
    
    Const WORKSHEET_NAME As String = "Database Names"
    Const FIRST_ROW As Long = 1
    Const FIRST_COLUMN As Long = 2
    Const NEXT_COLUMN_ON_FIRST_BLANK As Boolean = True ' boosts efficiency
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(WORKSHEET_NAME)
    
    Dim Data(): Data = ws.UsedRange.Value
    Dim rCount As Long: rCount = UBound(Data, 1)
    Dim cCount As Long: cCount = UBound(Data, 2)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim c As Long, r As Long, rStr As String
    
    For c = FIRST_COLUMN To cCount
        For r = FIRST_ROW To rCount
            rStr = CStr(Data(r, c))
            If Len(rStr) = 0 Then
                If NEXT_COLUMN_ON_FIRST_BLANK Then Exit For
            Else
                If Not dict.Exists(rStr) Then dict(rStr) = c
            End If
        Next r
    Next c
       
    Set LocationsToDictionary = dict

End Function

Excel Formula (Microsoft365)

=LET(dlData,B2:B11,slData,'Database Names'!B1:C4,sfcIndex,2,Er,"",
    sl,TOCOL(IF(slData="","",slData),,1),lm,XMATCH(dlData,sl),
    dr,IFERROR(INT((lm-1)/ROWS(slData))+sfcIndex,Er),
dr)

or

=LET(dlData,B2:B11,slData,'Database Names'!B1:C4,sfcIndex,2,Er,"",
    sl,TOCOL(IF(slData="","",slData),,1),
    sr,INT((SEQUENCE(ROWS(sl))-1)/ROWS(slData)),
    dr,IFERROR(XLOOKUP(dlData,sl,sr)+sfcIndex,Er),
dr)

okay this worked so fast. i am going to try my best to understand what you did here. thank you very much! — Geofex, Jul 26 '23 at 20:14

score 0 · Answer 2 · answered Jul 27 '23 at 12:01

This solution uses a Scripting.Dictionary to store the city codes to be looked up. Otherwise it follows roughly the same structure and names that OP used.

    '// ALWAYS use option explicit
    Option Explicit
    
        '// Declare the variables to be used
        Dim columnLocationList As Range
        Dim columnLocations As Range
        Dim locations As Range
        
        '// Lookup dictionary for location -> column number
        Dim dictLocations As Scripting.Dictionary
        
    Public Sub GetCityColumnNumbers()
    
        Debug.Print "Start", Now

        '// Load the dictionary with city -> column lookups
        loadDictLocations
        
        '// Establish the list of cities
        With Sheets("Billings").Range("b1")
            Set columnLocationList = Range(.Cells(2), .End(xlDown))
            columnLocationList.Offset(0, 1).ClearContents
            columnLocationList.Style = "Normal"
        End With
        
        '// Process all the cities
        For Each columnLocations In columnLocationList
            With columnLocations
                If dictLocations.Exists(.Value) Then
                    .Offset(0, 1).Value = dictLocations.Item(.Value)
                Else
                    '// Highlight entries not found
                    .Offset(0, 1).ClearContents
                    .Style = "Bad"
                End If
            End With
        Next columnLocations
        
        
        Debug.Print "End", Now
        
    End Sub
    
    
    Public Sub loadDictLocations()
        
        Set dictLocations = New Scripting.Dictionary
        For Each locations In Sheets("Database Names").UsedRange
            Select Case True
            '// Ignore empty, blank or duplicate cells
            Case Len(locations.Value) = 0
            Case dictLocations.Exists(locations.Value)
                '// Highlight duplicate city code
                locations.Style = "Bad"
            Case Else
                dictLocations.Add locations.Value, locations.Column
            End Select
        Next locations

        Debug.Print "Dictionary loaded"
        
    End Sub

I have 1000 excel rows of values, some are duplicates, and I want to find what column number those values exist in on another tab in VBA

2 Answers2

Populate Column Indexes