Is there an efficient way to update data from one sheet to another with a match of a cell

[mecerrato]

I have a sheet that has a main tab and a data tab. I update the data tab daily by copying from a daily report I get automatically from a reporting portal. I dump that data into the data tab and have written some code to update some of the columns in the main tab. The code matches the loan number in column C, if a match is found it executes the copy and paste of the different cells I need. The code works perfectly but it is slow as I've added other columns to copy and because they are non-contiguous I had to write code for each Column I need. I am asking the experts to review my code and maybe show me a more efficient way of writing the code so it can run faster. The data it is searching through is only a couple of hundred rows, I don't think it should take too long. Here is my code:

Sub Update_Data()
ActiveSheet.Unprotect Password:="Mortgage1"
Application.ScreenUpdating = False
Dim stNow As Date
Dim sourceRng As Range
Dim destRng As Range
stNow = Now
lrowloans = Worksheets("Main").Range("A6").End(xlDown).Row
lrowdata = Worksheets("Data").Range("C11").End(xlDown).Row
Set sourceRng = Worksheets("Main").Range("A6:A" & lrowloans)
        Set destRng = Worksheets("Data").Range("C11:C" & lrowdata)
    
        Dim match As Boolean
        For Each sRng In sourceRng
    If sRng.Value <> "" Then
       With destRng
         Set dRng = .Find(What:=sRng.Value, After:=Worksheets("Data").Range("C11"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
         If Not dRng Is Nothing Then
             Set pasteRng = Worksheets("Main").Range("E" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("G" & dRng.Row & ":H" & dRng.Row)
             copyRng.Copy pasteRng
             Set pasteRng = Worksheets("Main").Range("B" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("D" & dRng.Row & ":E" & dRng.Row)
             copyRng.Copy pasteRng
             Set pasteRng = Worksheets("Main").Range("D" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("U" & dRng.Row & ":U" & dRng.Row)
             copyRng.Copy pasteRng
             Set pasteRng = Worksheets("Main").Range("M" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("Q" & dRng.Row & ":Q" & dRng.Row)
             copyRng.Copy pasteRng
             Set pasteRng = Worksheets("Main").Range("K" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("AP" & dRng.Row & ":AP" & dRng.Row)
             copyRng.Copy pasteRng
             Set pasteRng = Worksheets("Main").Range("N" & sRng.Row)
             Set copyRng = Worksheets("Data").Range("AW" & dRng.Row & ":AW" & dRng.Row)
             copyRng.Copy pasteRng
         End If
       End With
    End If
Next
    
    Application.ScreenUpdating = True
ActiveSheet.Protect Password:="Mortgage1"
End Sub

 

[mecerrato]

Whilst it would be relatively simple to delete rows on the Data sheet that were not found on the Main sheet it would slow down the macro.

Perhaps a separate procedure I can run with a seperate button after I update the data? I can try and retrofit your code and add the delete row commands?

 

[Fluff]

Which sheet are you trying to delete the rows from?

 

[mecerrato]

Which sheet are you trying to delete the rows from?

Main Sheet, if the loan is not in the Data Sheet I want the choice to delete it.

 

[Fluff]

In that case it would be easier to do that in a separate macro.

 

[mecerrato]

In that case it would be easier to do that in a separate macro.

Can you help me with this macro?

 

[Fluff]

You would need to start a new thread for that.