Optimizing Trim and Scripting Dictionary Code

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
I'm hoping someone can help me optimize this code. It works, just rather slowly (it took ~7 minutes to run against a rather small data set). Essentially, I'm comparing data

from one workbook (sI), to data in anotherworkbook (dI). Where the values exist inboth workbooks, I’m bringing over certain values from sI; to dI. In order for the match to work, I have to getrid of the spaces in a column on the sI workbook, which seems to take quite awhile.

Suggestions on how to make his cod run faster? I'll have to repeat it on another data set, so I really don't want this code to take 15 minutes to run.




Code:
Sub CompIssueData()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim d, s As Workbook
Dim i, j As Long
Dim Rng, cCell As Range
Dim RngList As Object
Set d = ThisWorkbook
Set dI = ThisWorkbook.Sheets("Issues") 'Has about 500 records
Set s = Workbooks.Open("C:\Users\NBKDA6K\Desktop\Daily Inventory\Input Files\BKR123")
Set sI = s.Sheets("BKR123_BKInventory") 'Has about 13K records
Set RngList = CreateObject("Scripting.Dictionary")

dlR1 = dI.Range("B" & Rows.Count).End(xlUp).Row
sLR1 = sI.Range("A" & Rows.Count).End(xlUp).Row
Set cCell = sI.Range("H2:H" & sLR1)
cCell.Value = Application.Trim(cCell)
For Each Rng In sI.Range("A2", sI.Range("A" & sI.Rows.Count).End(xlUp))
    If Not RngList.Exists(Rng.Value & "|" & Rng.Offset(0, 7)) Then
        RngList.Add Rng.Value & "|" & Rng.Offset(0, 7), Rng
    End If
Next
    For Each Rng In dI.Range("B2", dI.Range("B" & Rows.Count).End(xlUp))
        If RngList.Exists(Rng.Value & "|" & Rng.Offset(0, 5)) Then
            dI.Range("F" & Rng.Row).Value = sI.Range("J" & Rng.Row).Value
            dI.Range("H" & Rng.Row).Value = sI.Range("AC" & Rng.Row).Value
        End If
Next
    
RngList.RemoveAll
        
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Your code is making thousands of changes on the worksheet(s) that take some time to process. A faster method would be to read your ranges into arrays. From there, you'd be able to make a very fast run through all of the data and make changes to the array. Once complete, send the array back to the range all in one shot.

Here's a bit of reading on Arrays that was helpful to me: http://excelmacromastery.com/Blog/index.php/the-complete-guide-to-using-arrays-in-excel-vba/

For future readers, post back what works for your scenario. HTH
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,121
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top