Looking to make this macro Faster

nazar123 · Oct 3rd 2020

Hi,

Loooking to make this macro faster

Code

Sub STEP9()
Dim Val As String, wb1 As Workbook, wb2 As Workbook, srcWS As Worksheet, desWS As Worksheet
Dim i As Long, v1 As Variant, v2 As Variant, rngList As Object
Dim lastRow As Long
Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\1.xls")
Set wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx")
Set desWS = wb1.Worksheets(1)
Set srcWS = wb2.Worksheets(1)
lastRow = desWS.Range("B" & desWS.Rows.Count).End(xlUp).Row
If lastRow = 2 Then
ReDim v1(1 To 1, 1 To 1)
v1(1, 1) = desWS.Range("B2").Value
Else
v1 = desWS.Range("B2:B" & lastRow).Value
End If
v2 = srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).Resize(, 2).Value
Set rngList = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v1, 1)
Val = v1(i, 1)
If Not rngList.Exists(Val) Then
rngList.Add Key:=Val, Item:=i + 1
End If
Next i
For i = 1 To UBound(v2, 1)
Val = v2(i, 1)
If rngList.Exists(Val) Then
desWS.Cells(rngList(Val), 9) = v2(i, 2)
End If
Next i
Application.ScreenUpdating = True
wb1.Save
wb2.Save
wb1.Close
wb2.Close
End Sub

Display More

Thnx

davesexcel · Oct 3rd 2020

Hello,

What is the code doing and is it running slow?

Supply a sample workbook to go with the code so somebody can test it.

**royUK** · Oct 3rd 2020

I don't believe the code can be speeded up

baddyswing · Oct 28th 2020

Where you have,

Code

desWS.Cells(rngList(Val), 9) = v2(i, 2)

Is it possible to firstly read all the contents from column 9 in desWS worksheet into a variable, and then write into this new variable and finally write back out to the desWS worksheet at the end after the second loop? Something like this:

Code

Sub STEP9()
Dim Val As String, wb1 As Workbook, wb2 As Workbook, srcWS As Worksheet, desWS As Worksheet
Dim i As Long, v1 As Variant, v2 As Variant, rngList As Object
Dim lastRow As Long
' create v3 for reading in column 9 of desWS
Dim v3 as Variant
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\1.xls")
Set wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx")
Set desWS = wb1.Worksheets(1)
Set srcWS = wb2.Worksheets(1)
lastRow = desWS.Range("B" & desWS.Rows.Count).End(xlUp).Row
If lastRow = 2 Then
ReDim v1(1 To 1, 1 To 1)
v1(1, 1) = desWS.Range("B2").Value
Else
v1 = desWS.Range("B2:B" & lastRow).Value
End If
v2 = srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).Resize(, 2).Value
v3 = desWS.Range(desWS.cells(1, 9), desWS.cells(lastRow, 9)).Value
Set rngList = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v1, 1)
Val = v1(i, 1)
If Not rngList.Exists(Val) Then
rngList.Add Key:=Val, Item:=i + 1
End If
Next i
For i = 1 To UBound(v2, 1)
Val = v2(i, 1)
If rngList.Exists(Val) Then
' write into v3 first
v3(rngList(Val), 1) = v2(i, 2)
End If
Next i
' write v3 out to worksheet once
desWS.Range(desWS.cells(1, 9), desWS.cells(lastRow, 9)) = v3
Application.ScreenUpdating = True
wb1.Save
wb2.Save
wb1.Close
wb2.Close
End Sub

Display More

I made an assumption that the number of rows for column 9 in desWS is the same as column B.

TonyTuperello · Dec 5th 2020

The scripting dictionary will not allow you to add a duplicate key. As such, it must check to make sure the key already exists when you add it. Your code forces it to check twice. The way to avoid this is to turn off error trapping for just long enough to add the keys. Duplicates will still not be added.

Code

On Error Resume Next
For i = 1 To UBound(v1, 1)
rngList.Add Key:=Val, Item:=i + 1
Next i
On Error Goto 0 'Turns error catch back on

This should speed your code up by a fair amount if you are processing long lists.

I am not sure if this is your intention. As you have not uploaded a sample, I don't know what you are processing.

But, you are saving the value from the array as the key and making the item value of the dictionary the index of the array (+1?!?!) (which will not be sequential if there are duplicates!) This may be by design, but I don't see it.

Consider making the key and and the item the same for purely esthetic purposes. Is there a reason to save the value of i?

**royUK** · Dec 5th 2020

TonyTuperello

Welcome to the Forum. Please read the Forum Rules to understand how the Forum works and why I have added Code Tags to your post

All VBA code posted in the forum must be wrapped in code tags, which you omitted, including single-line code snippets.Be sure to use them in future posts.

How to use code tags

Note: no apostrophe in the tags, just used for demonstration here.

['code]

your code goes between these tags

['/code]

Or, just highlight all of the code and press the <> in the post menu above button to add the code tags.

Thanks.

Share

Tags