rcrumbliss
New Member
- Joined
- Jan 30, 2024
- Messages
- 11
- Office Version
- 365
- Platform
- Windows
I have been working on this for a couple days and it is frustrating. I have found many Posts about simple matching of criteria, but I cant figure how to make any of those methods work for my situation.
I have 2 worksheets in my book. The first worksheet is a master list of addresses. The address format for these is like this...
The second worksheet is a list of specific addresses formatted like this...
The problem I have is I need to look up the information in Sheet 2, find the specific row in Sheet 1 which pertains to the address in each row. So I need to look at the Street name, and then check if the street number falls within the Low/High range for that street. I have over 25000 address ranges to look through. The current method I have been using is very slow, taking 2 hours and more to look up the 1000 addresses in Sheet 2. I need to speed this up, but I am not finding a way to do it that works.
Can someone please help. Below is the code I am currently using. I cannot include the source data I am using due to privacy issues.
I have 2 worksheets in my book. The first worksheet is a master list of addresses. The address format for these is like this...
| Loop | Sequence | Low Address | High Address | Prefix | Street Name | Suffix |
| 1000 | 1500 | W | Anywhere | St |
The second worksheet is a list of specific addresses formatted like this...
| Loop | Sequence | Street Number | Prefix | Street Name | Suffix | Consignee | ||
The problem I have is I need to look up the information in Sheet 2, find the specific row in Sheet 1 which pertains to the address in each row. So I need to look at the Street name, and then check if the street number falls within the Low/High range for that street. I have over 25000 address ranges to look through. The current method I have been using is very slow, taking 2 hours and more to look up the 1000 addresses in Sheet 2. I need to speed this up, but I am not finding a way to do it that works.
Can someone please help. Below is the code I am currently using. I cannot include the source data I am using due to privacy issues.
VBA Code:
Public Sub ProcessFinal()
Dim OFile As Worksheet: Set OFile = Sheets("OUTPUT FILE") 'output file
Dim EC As Worksheet: Set EC = Sheets("ENTIRE CENTER") 'Entire Center
Dim IC As Worksheet 'Imported Closures
Dim CD As Worksheet 'Copy Data from PFT
Dim i As Integer 'Counter
Dim DupRow As Integer 'to save row of duplicates
Dim LoopNum, SeqNum As String
Dim FoundRow As Integer
For i = 2 To [match(2,1/(a:a<>""))]
If OFile.Range("D" & i).Value = "@@" Then LoopNum = 0 Else LoopNum = OFile.Range("D" & i).Value
If OFile.Range("E" & i).Value = "@@" Then SeqNum = 0 Else SeqNum = OFile.Range("E" & i).Value
FoundRow = CheckAdd(OFile.Range("G" & i), OFile.Range("H" & i), OFile.Range("I" & i), OFile.Range("J" & i), OFile.Range("K" & i))
If OFile.Range("D" & i) = EC.Range("C" & FoundRow) And OFile.Range("E" & i) = EC.Range("D" & FoundRow) Then
'Loop and Sequence are a match move on to next step
Else
'Loop and Sequence do not match, add new Loop/Seq to row "O" and update exclude
OFile.Range("N" & i) = "Yes"
OFile.Range("O" & i) = "Relooped, new Loop/Seq is : " & EC.Range("C" & FoundRow) & "/" & EC.Range("D" & FoundRow)
OFile.Range("P" & i) = "Verify New L/S in CLO if needed"
End If
Next
End Sub
Public Function CheckAdd(StrNum As String, Pfx As String, Street As String, Sfx As String, StrType As String) As Integer
Dim OFile As Worksheet: Set OFile = Sheets("OUTPUT FILE") 'output file
Dim EC As Worksheet: Set EC = Sheets("ENTIRE CENTER") 'Entire Center
Dim IC As Worksheet 'Imported Closures
Dim CD As Worksheet 'Copy Data from PFT
Dim rng As Range
Dim StreetNum As Long
StreetNum = CLng(StrNum)
On Error Resume Next
Err.Number = 0
Set rng = EC.Range("J:J").Find(What:=Street, LookIn:=xlValues)
rng.Find What:=Street, LookIn:=xlValues
myRow = rng.Row
Do While myRow < EC.[match(2,1/(a:a<>""))]
If EC.Range("F" & myRow) <= StreetNum And EC.Range("G" & myRow) >= StreetNum Then
'Call MsgBox("Match Found for" & StrNum & " " & Street & "at row: " & myRow & " of the Entire Center")
CheckAdd = myRow
Exit Function
Else
'MsgBox "No"
End If
Set rng = EC.Range("J:J").FindNext(rng)
myRow = rng.Row
Loop
End Function
