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]

 

[Norie]

If you really want code I'll can post something that uses VLOOKUP and won't involve any looping.

Probably be quicker to just put the VLOOKUP formula in B1 on the 'master' sheet and copy it down.

This is what the formula would look like, though you would obviously need to change [Book1.xlsx]Sheet1 to refer to the appropriate workbook/sheet.

=IFERROR(VLOOKUP(B1, [Book1.xlsx]Sheet1!A:B, 2,0), "")

 

[Peter_SSs]

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?

Yes there is, but what is it you want the code to do with these right now?
a) Ignore these new employees, or
b) Add the new employee ID and salary to the Master sheet, or
c) Something else?

Also for some reason, if column B in sheet1 has no salary, it does not overwrite the salary for that ID in Master file.

I also wasn't aware that could happen. Easy enough to deal with and I will do when the question above is resolved.

Probably be quicker to just put the VLOOKUP formula in B1 on the 'master' sheet and copy it down.

This is what the formula would look like, though you would obviously need to change [Book1.xlsx]Sheet1 to refer to the appropriate workbook/sheet.

=IFERROR(VLOOKUP(B1, [Book1.xlsx]Sheet1!A:B, 2,0), "")

Unless I'm misunderstanding what the OP has & wants, that would remove (up to) about 3,850 existing employee salaries from Master, leaving only the about 150 salaries from Sheet1

 

[Celticfc]

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.

You are correct, when I tried on 2x new/dummy workbooks, this was instantaneous.

On my local and master files, both ranges are on table but I also tried by converting tables back to range but would still take a minute.

My Master file is 3.7MB and local file is 1.7MB as there are other functions on different sheets that refer to ID’s etc. Would this have any impact on the code?

I can not get my head around this, it’s very strange and already spent 4-5 different codes online for the past 6 hours on this!

 

[Celticfc]

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.

Yes there is, but what is it you want the code to do with these right now?
a) Ignore these new employees, or
b) Add the new employee ID and salary to the Master sheet, or
c) Something else?

I also wasn't aware that could happen. Easy enough to deal with and I will do when the question above is resolved.


Unless I'm misunderstanding what the OP has & wants, that would remove (up to) about 3,850 existing employee salaries from Master, leaving only the about 150 salaries from Sheet1

I would like to a) ignore these new employees.

You are correct regarding the VLookup function as this would overwrite other salaries and would need other helpers columns and then changing the formula to values etc. This was the first thing came to my mind as my knowledge is only basic in VBA.

I also replied to another member above, would the filesize play any role on the processing time the code takes to run? When I test it on 2xblank documents, all the codes posted here run instantaneous. On my master and local files, your code takes about 37 secs (it takes longer with calculation set to manual!) which is the closes we got.

The timing is extremely important as there are about 40 other local files and this process will be scheduled for 8am every workday.

Thank you for all the support.

 

[Peter_SSs]

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

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

 

[Celticfc]

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

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

Hi, thank you again.
Can you kindly alter your code so ID’s are now on column Kand salaries on column S? I couldn’t manage it sorry.

 

[Peter_SSs]

Hi, thank you again.
Can you kindly alter your code so ID’s are now on column Kand salaries on column S? I couldn’t manage it sorry.

In both sheets?

 

[Celticfc]

Yes please.

 

[Peter_SSs]

Can you kindly alter your code so ID’s are now on column Kand salaries on column S?

Try

Sub UpdateSalaries_v3()
  Dim a As Variant, ID As Variant
  Dim d1 As Object, d2 As Object
  Dim i As Long, lr As Long
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    lr = .Range("K" & .Rows.Count).End(xlUp).Row
    a = Application.Index(.Cells, Evaluate("Row(2:" & lr & ")"), Array(11, 19))
  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")
    lr = .Range("K" & .Rows.Count).End(xlUp).Row
    a = Application.Index(.Cells, Evaluate("Row(2:" & lr & ")"), Array(11, 19))
    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
    .Range("S2").Resize(UBound(a)).Value = Application.Index(a, 0, 2)
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[Celticfc]

In both sheets?

Can’t thank you enough and everything now works perfect,takes about 2 seconds!
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?