Streamline Code

[RLJ]

Hello,

It has been a while since I have asked a question, but I have a need for the bottom code to be streamlined. This code takes a really long time to run when there are hundreds of rows that I am updating.
I have a workbook with a Sheet Named Working Master and a Sheet Named Temp. The Working Master is the sheet that needs to be updated from the Temp Sheet. Basically, what I am doing is taking data from a separate workbook, pasting it into the Temp Sheet and running the code to look up each value in column A on the Temp sheet to the Working Master Sheet and cop/paste the data from the Temp sheet to the Working Master sheet. Where this code gets really clunky and needs some serious help is that I have multiple offset cells that I copy/paste one by one to the Working Master. I have used this code on multiple other projects over the years and the current project that I am modifying the code for, I need to copy/paste Range(E:DX) for each unique value in Column A on the Temp sheet to the Working Master sheet. I have to use the lookup function on the Working Master as the rows are not in the same order between both sheets.

Here is the code that I have been using:

Sub FindKey()
 
    '/////////////////////////////////////////////////////////////////////////
  
    'Sheets used
    'ImportTemp (Sheet where the temp data is housed to copy over values from
    'Working Master (WorkingMaster) Main Sheet where data is being copied to
  
    '/////////////////////////////////////////////////////////////////////////
  
    Application.ScreenUpdating = False
    Dim lookVal As String
  
    Temp.Select
    Range("A2").Select 'Temp Sheet for copying values over to Missing AC Sheet
  
    Do Until IsEmpty(ActiveCell.Value)
      
    lookVal = ActiveCell.Value 'Key# from Column A
  
    WorkingMaster.Select 'Main Sheet that is being Updated
  
    Cells.Find(What:=lookVal, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
        Range("A" & (ActiveCell.Row)).Select
      
    Temp.Select
    ActiveCell.Offset(0, 4).Copy
  
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 5).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 6).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 7).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 8).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 9).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 10).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 11).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 12).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 13).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 14).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 15).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 16).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 17).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 18).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
    ActiveCell.Offset(0, 19).Copy
 
    WorkingMaster.Select 'Main Sheet that is being Updated
    ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks _
        :=False, Transpose:=False
 
    Temp.Select
 
        
 
    ActiveCell.Offset(1, 0).Select
    Loop
  
    WorkingMaster.Select
  
    Application.ScreenUpdating = True
  
End Sub

I am open to updating this or a completely new way of doing this.

I thank everyone who will take a look at this and give me input. I do truly appreciate it.

 

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one cell at a time which will take along time if you have got 50000 cells it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),

I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
I have completely rewritten your code but this should do the same thing, it copies the data from the temp sheet into one variant array and the data from the master into another varainta array, and then does double loop to check each value from the temp shet and find the equavalent on the master and then copies the data from one array to the other:

Sub FindKey()
Dim temp As Worksheet
Dim workingmaster As Worksheet 
Set temp = Worksheets("Sheet1")  ' set as you require
Set workingmaster = Worksheets("Sheet2") ' set as you require


    '/////////////////////////////////////////////////////////////////////////

    'Sheets used
    'ImportTemp (Sheet where the temp data is housed to copy over values from
    'Working Master (WorkingMaster) Main Sheet where data is being copied to

    '/////////////////////////////////////////////////////////////////////////

'    Application.ScreenUpdating = False  unnecessary because this code only does one screen update
    Dim lookVal As String

    temp.Select
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row ' fine last row
    temparr = Range(Cells(1, 1), Cells(lastrow, 19)) ' loadt all the data on the temp workshset into a variant array
  

    workingmaster.Select 'Main Sheet that is being Updated
    lastmast = Cells(Rows.Count, "A").End(xlUp).Row ' fine last row
    mastarr = Range(Cells(1, 1), Cells(lastmast, 19)) ' load all of the master data into an array
    For i = 2 To lastrow  ' loop through the temp data
     For j = 2 To lastmast ' loop through the master data for temp value
       If temparr(i, 1) = mastarr(j, 1) Then  ' check if the values are equal
        ' if so copy column D to t ( column number 4 to 19)
        For k = 4 To 19
        mastarr(j, k) = temparr(i, k)
        Next k
       End If
     Next j
   Next i
' write the array back to the worksheet
  Range(Cells(1, 1), Cells(lastmast, 19)) = mastarr
 
 
   ' Application.ScreenUpdating = True

End Sub

Note I have got rid of the screen updating statement because this code only does one update to the worksheet, and you need to do one update!!

 

[RLJ]

Thank you @offthelip for the code above. I'm hoping to have time today to look at it and see if it is what I need. I appreciate your help.