Excel freezes looping through many cells to match criteria btw. wkbks

[KC E]

Hello,

I'm using Excel 2016 and trying to match addresses btw. 2 workbooks, the Address and a HUGE (60,000 to sometimes 300,000 row) Billing workbooks.

The Address wkbk will be populated by data from the huge Billing wkbk, as follows:
* When I find a match, the code will populate the Address wkbk with the matching address from the huge Billing wkbk.
* When I find a matching address, the code will also use OFFSET to populate the Address wkbk with the housekey and the bridger of that matching address from the huge Billing wkbk.
* A LEFT function will then work within just the Address wkbk to pull the 1st 6 digits/characters from the bridger to populate the Node column.

Problem:
My problem is the code taking so long to loop through the cells to do this matching (Vlookup-type) btw. workbooks (no errors). When I tried an alternate way using 'FOR EACH cel in Range(my column name)' it froze many times and Excel said 'Not responding', and I had to force close Excel.

Comments:
* I've looked up tips on the internet and I use Application.ScreenUpdating = False and Application.ScreenUpdating = True.
* I refer to just the used range in both workbooks.

Question:
Can someone help speed this up?
- I don't know about L or UBound or Array, so not sure if that would help.
- Would also copying one of the workbooks to a 2nd sheet on the other workbook help so it's not going between workbooks?

I've attached the 2 workbooks, if it would help to see the data.
* I had to cut many of the rows in the Billing wkbk b/c the file size was too big to upload. In this particular case, it should have actually 69,000 rows.
* Please skip the part btw. START FORMATTING and END FORMATTING. I have actually already formatted the workbooks as it should be after this code is run. It's the START HERE followed by CALCULATIONS section that is the issue.
* I've set it up so that it will only return 11365 Wellisville Rd and its housekey and bridger. I'll have to set it up to include Unit#s later so that apartments on the same street can be matched btw. workbooks.

Thank you for your help.

Sub nodesghelp()

Dim wkbkAddr As Workbook
Dim sName1 As String
Dim a As Long
Dim alastrow As Long

Dim wkbkBilling As Workbook
Dim sName2 As String
Dim b As Long
Dim blastrow As Long
'Dim bcell As Range

Dim crit As String
Dim hsekey As String
Dim brdger As String
'Dim cel As Range

Application.ScreenUpdating = False

sName1 = Workbooks(2).Name
sName2 = Workbooks(3).Name

'Set wkbk names
If sName1 Like "*addr*" Then
    Set wkbkAddr = Workbooks(sName1)
    Set wkbkBilling = Workbooks(sName2)
ElseIf sName1 Like "*Billing*" Then
    Set wkbkBilling = Workbooks(sName1)
    Set wkbkAddr = Workbooks(sName2)
End If

'---ADDRESS LIST---
wkbkAddr.Activate

alastrow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row

'insert columns/headings in address list
Columns("A:D").Insert shift:=xlToRight
Range("A1").Value = "Node" 'vlookup column
Range("B1").Value = "Bridger" 'vlookup column
Range("C1").Value = "Housekey" 'vlookup column
Range("D1").Value = "Address" 'vlookup column
Range("A1:D1").Font.Bold = True
Range("A1:D1").Interior.Color = RGB(255, 242, 204)
Range("C:C").NumberFormat = "@" 'make housekey column text so housekeys not change to sci notation

'---START FORMATTING---address helper column--OMIT
Columns("H:H").Insert shift:=xlToRight
Range("H1").Value = "Helper Address" 'helper column
Range("H1").Font.Bold = True
Range("H1").Interior.Color = RGB(255, 242, 204)


Range("H2").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(TRIM(RC[1]) & TRIM(RC[3])&TRIM(RC[5])&TRIM(RC[6]), "" "","""")"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H" & alastrow)
Range("H2:H" & alastrow).Select
Selection.Copy
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("H:H").EntireColumn.AutoFit

'Sort address list
Range("m1").Select
'Begin Sort
wkbkAddr.ActiveSheet.Sort.SortFields.Clear
'Sort Street name
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("m2:m" & alastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
'Sort Street Number
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("i2:i" & alastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
'Sort Unit Number
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("f2:f" & alastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
End With


'---BILLING---
wkbkBilling.Activate

blastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'insert helper address column and concatenate addresses
Columns("E:E").Insert shift:=xlToRight
Range("E1").Value = "Helper Address"
Range("E1").Font.Bold = True
Range("E1").Interior.Color = RGB(255, 242, 204)

'concatenate/trim address
Range("E2").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(TRIM(RC[-3])&TRIM(RC[-2]),"" "","""")"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & blastrow)
Range("E2:E" & blastrow).Select
Selection.Copy
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("E:E").EntireColumn.AutoFit

'Sort billing
'Begin Sort
ActiveSheet.Sort. _
    SortFields.Clear
'Sort Street name
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("c2:c" & blastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
'Sort Street Number
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("b2:b" & blastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
'Sort Unit Number
ActiveSheet.Sort. _
    SortFields.Add Key:=Range("d2:d" & blastrow), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
End With

'---END FORMATTING---END OMIT
          
'---ADDRESS LIST---START HERE
wkbkAddr.Activate

'---CALCULATIONS--concatenate and vlookup address list -REDO THIS SECTION
For a = 2 To alastrow
crit = wkbkAddr.ActiveSheet.Cells(a, "H").Value

'Add matching address to Address List
wkbkBilling.Activate

For b = 2 To blastrow
    If ActiveSheet.Cells(b, "E").Value = crit Then
        wkbkAddr.Sheets(1).Activate
        ActiveSheet.Cells(a, "D").Value = crit
    End If
Next b

Next a

'Add matching houseky to Address List
For a = 2 To alastrow
crit = wkbkAddr.ActiveSheet.Cells(a, "H").Value

wkbkBilling.Activate

For b = 2 To blastrow
    If ActiveSheet.Cells(b, "E").Value = crit Then
        hsekey = ActiveSheet.Cells(b, "E").Offset(0, -4).Value
        wkbkAddr.Sheets(1).Activate
        ActiveSheet.Cells(a, "C").Value = hsekey
    End If
Next b

Next a

'Add matching Bridger to Address List
For a = 2 To alastrow
crit = wkbkAddr.ActiveSheet.Cells(a, "H").Value

wkbkBilling.Activate

For b = 2 To blastrow
    If ActiveSheet.Cells(b, "E").Value = crit Then
        brdger = ActiveSheet.Cells(b, "E").Offset(0, 9).Value
        wkbkAddr.Sheets(1).Activate
        ActiveSheet.Cells(a, "B").Value = brdger
    End If
Next b

Next a

'use LEFT to get node name from bridger for Address list
wkbkAddr.Activate

For Each cel In Range("B2:B" & alastrow)
    If Len(cel.Value) > 6 Then
        cel.Offset(0, -1).Value = Trim(Left(cel.Value, 6))
    Else
        cel.Offset(0, -1).Value = Trim(cel.Value)
    End If
Next cel


Application.ScreenUpdating = True

End Sub

 

[Kenneth Hobson]

Use With for multiple common object references like workbooks, worksheets, workbook.worksheet, etc. Even embedded With's can help.

So, With, is going to be better than relying on Activate or Select.
e.g.

     With wkbkAddr.ActiveSheet
          alastrow = .Range("D" & .Rows.Count).End(xlUp).Row
     End With

Note: wkbkAddr.WorkSheets(1) or wkbkAddr.WorkSheets("Sheet1") or such is better than wkbkAddr.ActiveSheet.


Here are two other speed options which can "sometimes" help:

     Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual

At the end, set those to True and xlAutomaticCalculation.

Here is how to skip Select, change:

Range("E2").Select
     Selection.AutoFill Destination:=Range("E2:E" & blastrow)

to

Range("E2").AutoFill Destination:=Range("E2:E" & blastrow)

This would be even better with fully qualified workbook.worksheet or that in a With.

 

[NARAYANK991]

Hi ,

I am not clear on your problem ; can you , very simply detail the following :

1. What data item or items or even better , which cell / column in which workbook , are you using as the lookup value ?

2. Which column in which workbook will be used as the lookup range ?

I am at a loss to understand why a lookup should loop through thousands of cells , when Excel offers a VLOOKUP function or a MATCH function which will do the same in a fraction of the time.

Narayan

 

[KC E]

Hi ,

I am not clear on your problem ; can you , very simply detail the following :

1. What data item or items or even better , which cell / column in which workbook , are you using as the lookup value ?

2. Which column in which workbook will be used as the lookup range ?

I am at a loss to understand why a lookup should loop through thousands of cells , when Excel offers a VLOOKUP function or a MATCH function which will do the same in a fraction of the time.

Narayan

You are correct, Narayan. On Monday, I think, I read that you can use Vlookup in VBA. For some reason I didn't think you could.

I'm going to try to redo my code and add the Application on/off code the other replier mentioned and maybe copy the Billing data to a wksht in the Address wkbk to make it go a little faster.

To answer your questions: 1) I'm using the 'Helper Address' column H, starting with cell H2, in the Address wkbk as the lookup value to lookup values 2) in the 'Helper Address' column E (the lookup range), starting in E2, in the Billing wkbk.

Where the answers will go:
The code will match the addresses btw. the Billing wkbk and Address wkbk and return that address (column E) from the Billing wkbk to the 'Address' column of the Address wkbk.

The code will match the addresses btw. the Billing wkbk and Address wkbk and return that housekey (column A) from the Billing wkbk to the 'Housekey' column of the Address wkbk.

Then, the code will match the addresses btw. the Billing wkbk and Address wkbk and return that bridger (column N) from the Billing wkbk to the 'Bridger' column of the Address wkbk.

Let me know if that helps. Thank you for your help.

 

[NARAYANK991]

Hi ,

This is a requirement tailor made for the use of INDEX and MATCH , since if you once obtain the match value , all you have to do is use it in different columns to return different pieces of information.

Narayan

 

[KC E]

Hi ,

This is a requirement tailor made for the use of INDEX and MATCH , since if you once obtain the match value , all you have to do is use it in different columns to return different pieces of information.

Narayan

Thank you for the help!