Speeding Up Loop Code

[Celticfc]

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.

[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]

 

[footoo]

Untested :

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

 

[Peter_SSs]

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.

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

 

[Norie]

Couldn't you use VLOOKUP for this?

 

[Celticfc]

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.

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:

 a(d2(ID), 2) = d1(ID)

 

[Peter_SSs]

Hello,

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

 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'

 

[Celticfc]

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.

 

[footoo]

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.

 

[Celticfc]

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.

 

[footoo]

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.