Speeding Up Loop Code

Celticfc

Board Regular
Joined
Feb 28, 2016
Messages
152
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]
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,452
Office Version
  1. 365
Platform
  1. Windows
Untested :
Code:
Sub wscopy()
Dim sh_1 As Worksheet, sh_3 As Worksheet
Dim rng1 As Range, rng3 As Range, cel As Rng, fnd As Range


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


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Last edited:
Upvote 0

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
58,548
Office Version
  1. 365
Platform
  1. Windows
This should be pretty fast. I doubt you will need to worry about ScreenUpdating or xlCalculation settings but you can add that if needed. You'll also probably want to get rid of the MsgBox line in due course.

Test in a copy of your workbook.
Code:
Sub UpdateSalaries()
  Dim a As Variant, ID As Variant
  Dim d1 As Object, d2 As Object
  Dim i As Long
  
  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)
    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()
        a(d2(ID), 2) = d1(ID)
      Next ID
      .Value = a
    End With
  End With
  MsgBox "Done"
End Sub
 
Last edited:
Upvote 0

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,358
Office Version
  1. 365
Platform
  1. Windows
Couldn't you use VLOOKUP for this?
 
Upvote 0

Celticfc

Board Regular
Joined
Feb 28, 2016
Messages
152
This should be pretty fast. I doubt you will need to worry about ScreenUpdating or xlCalculation settings but you can add that if needed. You'll also probably want to get rid of the MsgBox line in due course.

Test in a copy of your workbook.
Code:
Sub UpdateSalaries()
  Dim a As Variant, ID As Variant
  Dim d1 As Object, d2 As Object
  Dim i As Long
  
  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)
    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()
        a(d2(ID), 2) = d1(ID)
      Next ID
      .Value = a
    End With
  End With
  MsgBox "Done"
End Sub

Hello,

It worked a few times as I was testing but keep getting subscript out of range error for the line below:

Code:
 a(d2(ID), 2) = d1(ID)
 
Upvote 0

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
58,548
Office Version
  1. 365
Platform
  1. Windows
Hello,

It worked a few times as I was testing but keep getting subscript out of range error for the line below:

Code:
 a(d2(ID), 2) = d1(ID)
Is it possible that an ID in 'Sheet1' does not exist in 'Master', or blank cells among the IDs in 'Sheet1'? When you get the error, click Debug & hover your mouse cursor over ID in the yellow line and see what the ID value is. Check that ID exists in 'Master'
 
Last edited:
Upvote 0

Celticfc

Board Regular
Joined
Feb 28, 2016
Messages
152
Is it possible that an ID in 'Sheet1' does not exist in 'Master', or blank cells among the IDs in 'Sheet1'? When you get the error, click Debug & hover your mouse cursor over ID in the yellow line and see what the ID value is. Check that ID exists in 'Master'
Yes that's correct, not all ID's will be in Master (new emplyees in sheet1 are not added to master list till 1 year). Is there a way around this? Also for some reason, if column B in sheet1 has no salary, it does not overwrite the salary for that ID in Master file.
 
Upvote 0

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,452
Office Version
  1. 365
Platform
  1. Windows
Celticfc
Have you tried the code I posted?
With only 160 items to process, I don't think there will any noticeable run-time difference between my macro and Peter_SSs's.
Norie's suggestion is the simplest. If you prefer a macro, could create one that makes use of VLOOKUP - would also be fast.
 
Upvote 0

Celticfc

Board Regular
Joined
Feb 28, 2016
Messages
152
Celticfc
Have you tried the code I posted?
With only 160 items to process, I don't think there will any noticeable run-time difference between my macro and Peter_SSs's.
Norie's suggestion is the simplest. If you prefer a macro, could create one that makes use of VLOOKUP - would also be fast.
Hi Footoo,
Yes I have tried and it’s still taking about a minute. Even thoughits only 150 ID’s, its looping through almost 4000 on the master file.

 
Upvote 0

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,452
Office Version
  1. 365
Platform
  1. Windows
Hi Footoo,
Yes I have tried and it’s still taking about a minute. Even thoughits only 150 ID’s, its looping through almost 4000 on the master file.
Strange that it takes one minute.
I've just tested and it took about 1 second.
It only loops 150 times - it does not loop through the 4000 entries on the master file.
 
Upvote 0

Forum statistics

Threads
1,186,732
Messages
5,959,428
Members
438,423
Latest member
jdcp

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
Top