Speeding Up Loop Code

Celticfc · Jul 5, 2018

Hi all,

Column A in Sheet 1 has 150 Employee ID’s and Column B has their salary.All I’m doing is pasting their salary to the Master sheet (which has 4000ID’s).
This process take about 1 minute to complete.
Is there a way to speed it up at all? I was wondering if the loop canstop once all 150 ID’s have been found? I.e. those 150 ID’s could be betweenrows 1-500 in Master Sheet so I don’t want it to check all the way to 4000rows?

Thank you very much in advance.

Code:

[COLOR=black][FONT=Calibri Light]Private Sub lookupandcopy[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]

[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]
Dim j As Long, i As Long
Dim sh_1, sh_3 As Worksheet
Dim MyName As String[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]

[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]
Set sh_1 = ThisWorkbook.Sheets("sheet1")
Set sh_3 = Workbooks("master.xlsb").Sheets("master")[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]For j = 1 To 150
MyName = sh_1.Cells(j, 1).Value[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]
[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]For i = 1 To 4000
    If sh_3.Cells(i, 1).Value = MyName Then
        sh_3.Cells(i, 2).Value = sh_1.Cells(j,2).Value
    End If[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]

[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]   Next i[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]
[/FONT][/COLOR][COLOR=black][FONT=Calibri Light] Next j[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]

[/FONT][/COLOR][COLOR=black][FONT=Calibri Light]
[/FONT][/COLOR][COLOR=#222222][FONT=Calibri Light]Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[/FONT][/COLOR]

Peter_SSs · Jul 6, 2018

Celticfc said:
Can’t thank you enough and everything now works perfect,takes about 2 seconds!

That still seems extremely slow to me. I'm wondering if it is the recalculation after the code has really done its job? I'd be interested to know the result of running the code after temporarily adding these blue lines of code where shown.

Rich (BB code):

Sub UpdateSalaries_v3()
  Dim a As Variant, ID As Variant
  Dim d1 As Object, d2 As Object
  Dim i As Long, lr As Long
  
  Dim t As Single
  t = Timer
  Application.ScreenUpdating = False
.
.
  End With
  MsgBox "Time to here = " & Format(Timer - t, "0.000 secs")
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Celticfc said:
Whilst testing noticed some salaries did not populate and it’sbecause some ID’s are stored as string on sheet1 but as numbers on mastersheet.
i.e. a user ID appears as 0038921 on sheet1 but 38921 on Mastersheet. Is there a way to wrap sheet1 ID’s with Value function within this code?

Wouldn't be worth trying to standardise your sheets so all IDs were stored the same way?

Are all ID's numerical (apart from the fact that some are stored as text)?
Or do some IDs actually contain non-digit characters?

footoo · Jul 6, 2018

I'd also be interested in the timing per this :

Code:

Sub wscopy()
Dim sh_1 As Worksheet, sh_3 As Worksheet
Dim rng1 As Range, rng3 As Range, cel As Range, fnd As Range
[COLOR=#0000ff]Dim t As Single[/COLOR]
[COLOR=#0000ff]t = Timer[/COLOR]
Set sh_1 = ThisWorkbook.Sheets("sheet1")
Set sh_3 = Workbooks("master.xlsb").Sheets("master")
With sh_1
    Set rng1 = .Range(.[A1], .Cells(Rows.Count, "A").End(xlUp))
End With
With sh_3
    Set rng3 = .Range(.[A1], .Cells(Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each cel In rng1
    Set fnd = rng3.Find(cel)
    If Not fnd Is Nothing Then fnd(1, 2) = cel(1, 2).Value
Next
[COLOR=#0000ff]MsgBox "Time to here = " & Format(Timer - t, "0.000 secs")[/COLOR]
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Celticfc · Jul 6, 2018

Peter_SSs said:
That still seems extremely slow to me. I'm wondering if it is the recalculation after the code has really done its job? I'd be interested to know the result of running the code after temporarily adding these blue lines of code where shown.

Rich (BB code):

Sub UpdateSalaries_v3() Dim a As Variant, ID As Variant Dim d1 As Object, d2 As Object Dim i As Long, lr As Long Dim t As Single t = Timer Application.ScreenUpdating = False . . End With MsgBox "Time to here = " & Format(Timer - t, "0.000 secs") Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

Wouldn't be worth trying to standardise your sheets so all IDs were stored the same way?

Are all ID's numerical (apart from the fact that some are stored as text)?
Or do some IDs actually contain non-digit characters?

It took 4.3xx second and then hang for 2 secs for screen update/calculation however on a dummy workbook, same ID/Salary contents took 1.xx sec.
Yes I've sorted the Value issue as this was due to another function.
Thank you again.

Celticfc · Jul 6, 2018

footoo said:

I'd also be interested in the timing per this :

Code:

Sub wscopy()
Dim sh_1 As Worksheet, sh_3 As Worksheet
Dim rng1 As Range, rng3 As Range, cel As Range, fnd As Range
[COLOR=#0000ff]Dim t As Single[/COLOR]
[COLOR=#0000ff]t = Timer[/COLOR]
Set sh_1 = ThisWorkbook.Sheets("sheet1")
Set sh_3 = Workbooks("master.xlsb").Sheets("master")
With sh_1
    Set rng1 = .Range(.[A1], .Cells(Rows.Count, "A").End(xlUp))
End With
With sh_3
    Set rng3 = .Range(.[A1], .Cells(Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each cel In rng1
    Set fnd = rng3.Find(cel)
    If Not fnd Is Nothing Then fnd(1, 2) = cel(1, 2).Value
Next
[COLOR=#0000ff]MsgBox "Time to here = " & Format(Timer - t, "0.000 secs")[/COLOR]
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

70.xxx seconds and the screen was flicking from not responding to normal mode a few times. The one you posted earlier was around 1 min but was instantaneous on a new blank workbook with same amount of ID's. Maybe something in my modules is interfering with this loop but not sure how.

Nevertheless I'm content with <5 secs time.

Thank you for the support.

Peter_SSs · Jul 6, 2018

Celticfc said:
Yes I've sorted the Value issue as this was due to another function.

OK, good.

Celticfc said:
Maybe something in my modules is interfering with this loop but not sure how.

Perhaps some 'event' code is operational here & the speed might be enhanced with turning those off/on too?

Rich (BB code):

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

Celticfc · Jul 9, 2018

Peter_SSs said:

I have addressed the blanks and new employee issues in this version, and added in the ScreenUpdating/Calculation codes. How does it compare?

Code:

Sub UpdateSalaries_v2()
  Dim a As Variant, ID As Variant
  Dim d1 As Object, d2 As Object
  Dim i As Long
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    a = .Range("A2", .Range("B" & .Rows.Count).End(xlUp)).Value
  End With
  For i = 1 To UBound(a)
    If Len(a(i, 1)) > 0 And Len(a(i, 2)) > 0 Then d1(a(i, 1)) = a(i, 2)
  Next i
  With Sheets("Master")
    With .Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
      a = .Value
      For i = 1 To UBound(a)
        d2(a(i, 1)) = i
      Next i
      For Each ID In d1.Keys()
        If d2.exists(ID) Then a(d2(ID), 2) = d1(ID)
      Next ID
      .Value = a
    End With
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Hello again,

May I please ask,

How can I avoid employees that are not “Manager” in Column S?

On another function, I don’t want to pick up the salaries of employees that are not managers basically.

So, can the code check Column S to see if is a Manager, if it is then add to dictionary if not then avoid that employee ID?

Thanks again.

Peter_SSs · Jul 9, 2018

I'm a little confused. You have posted _v2 code when you had previously asked for that code to be amended because of your column layout. In post 16 you had said IDs were in col K and Salaries in col S. Now you are saying Manager is in col S and the _v2 code looks for IDs and Salaries in cols A & B. Please clarify.

Also, did you try my suggestion for post 25, and if so did it make any difference to the run-time?

Celticfc · Jul 9, 2018

Peter_SSs said:
I'm a little confused. You have posted _v2 code when you had previously asked for that code to be amended because of your column layout. In post 16 you had said IDs were in col K and Salaries in col S. Now you are saying Manager is in col S and the _v2 code looks for IDs and Salaries in cols A & B. Please clarify.

Also, did you try my suggestion for post 25, and if so did it make any difference to the run-time?

Yes I’ve tried and I’ve settled with enableevents and screenuodating as false/true but left out .calculation as for some reason it’s adding more to processing.

Yes correct, I’ve been changing my ranges/columns as I’m going along.

What I did for now is sort column S by Manager so all managers appear on top, and then count the number of managers and apply this count to your code. I.e. if I have 40 managers, then my variable is 40+1 instead of last row/end. This way I’m only collecting the ID/Salary of my managers and only copying them using your code.

This is however a temporary fix and I’m vary that something might go wrong so that’s why I need to amend your code that looks at Column S for position (manager). This way I won’t have to sort either which would save 2-3 seconds.

Thanks again.

Peter_SSs · Jul 9, 2018

That didn't clarify much about what the current column arrangement actually is other than Manager in S, so ..
- What is the ID column now?
- What is the salary column now?
- Are the column layouts on both sheets still identical?

Celticfc · Jul 10, 2018

Peter_SSs said:
That didn't clarify much about what the current column arrangement actually is other than Manager in S, so ..
- What is the ID column now?
- What is the salary column now?
- Are the column layouts on both sheets still identical?

Hi,
Yes ID in A, Salary in B and Position on S.

Speeding Up Loop Code

Celticfc

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Excel Facts

footoo

Well-known Member

Celticfc

Board Regular

Celticfc

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Celticfc

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Celticfc

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Celticfc

Board Regular

Similar threads

Forum statistics

Share this page

Speeding Up Loop Code

Board Regular

MrExcel MVP, Moderator

Excel Facts

Well-known Member

Board Regular

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock