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

Question

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.
The code works perfectly but it is slow as I've added other columns to copy.
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

Answer 1

This will run just about as fast as your computer can do the job. Any difference is achieved by reading from the sheets less frequently. I didn't find any significant sources for delay in your code, such as avoidable loops.
Option Explicit
' the assigned numbers are Excel's column numbers
' Test: Debug.Print Columns(NmcName).Address(0,0)
Enum Ndc ' "Data" columns enumeration
' 132 - 08 Dec 2020
NdcName = 4 ' 4 = column D
NdcProc ' "Processor"
NdcPurp = 7 ' "Purpose"
NdcProd ' "Product type"
NdcLockX = 17 ' "Lock Expiry"
NdcLoan = 21 ' "Loan amount"
NdcCD = 42 ' "CD issued"
NdcClose = 49 ' "Closing date"
End Enum
Enum Nmc ' "Main" columns
' 132 - 08 Dec 2020
NmcName = 2 ' 2 = column B
NmcProc ' "Processor"
NmcLoan ' "Loan amount"
NmcPurp ' "Purpose"
NmcProd ' "Product type"
NmcCD = 11 ' "CD issued"
NmcLockX = 13 ' "Lock Expiry"
NmcClose ' "Closing date"
End Enum
Sub Update_Data()
' 132 - 08 Dec 2020
Const pWord As String = "Mortgage1"
Dim WsMain As Worksheet
Dim WsData As Worksheet
Dim sourceRng As Range
Dim destRng As Range
Dim sCell As Range ' loop object
Dim Fnd As Range ' cell found by Find
Dim SrcArr As Variant ' data from Fnd.Row
Dim SrcClm As Variant ' array of source columns
Dim DstClm As Variant ' array of destination columns
Dim C As Long ' loop counter: column
Set WsMain = Worksheets("Main")
Set WsData = Worksheets("Data")
With WsMain
.Unprotect Password:=pWord ' presuming WsMain is your AciveSheet
Set sourceRng = .Range(.Cells(6, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
With WsData
Set destRng = .Range(.Cells(11, "C"), .Cells(.Rows.Count, "C").End(xlUp))
End With
' data will be copied from SrcClm to DstClm, like NdcPurp to NmcPurp
' sequence is immaterial but position must match
' number of columns in both arrays must be identical
' effect modifications in the Enum
SrcClm = Array(NdcPurp, NdcProd, NdcName, NdcProc, NdcLoan, NdcLockX, NdcCD, NdcClose)
DstClm = Array(NmcPurp, NmcProd, NmcName, NmcProc, NmcLoan, NmcLockX, NmcCD, NmcClose)
Application.ScreenUpdating = False
For Each sCell In sourceRng
If sCell.Value <> "" Then
With destRng
Set Fnd = .Find(What:=sCell.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not Fnd Is Nothing Then
SrcArr = .Range(.Cells(Fnd.Row, 1), .Cells(Fnd.Row, NdcClose)).Value
For C = LBound(SrcClm) To UBound(SrcClm)
WsMain.Cells(sCell.Row, DstClm(C)).Value = SrcArr(1, SrcClm(C))
Next C
End If
End With
End If
Next sCell
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
WsMain.Protect Password:=pWord
End Sub
The code's syntax has been tested but, for lack of data, not its functionality. Especially the coordination of enumerations Ndc and Nmc with the arrays SrcClm and DstClm may write some values to the wrong columns. Here's how you can fix that. Look for these two arrays.
SrcClm = Array(NdcPurp, NdcProd, NdcName, NdcProc, NdcLoan, NdcLockX, NdcCD, NdcClose)
DstClm = Array(NmcPurp, NmcProd, NmcName, NmcProc, NmcLoan, NmcLockX, NmcCD, NmcClose)
SrcClm lists all used columns in the source sheet. DstClm lists all used columns in the destination sheet. You can add, delete or change either. The sequence is immaterial. But for every Source cell there must be a destination cell. Therefore the number of columns in both arrays must always be the same.
The arrays specify columns. The rows will be found by the code. The Source row is determined one after the other, in a loop. The Destination row is Fnd.Row. Now the code works through the two arrays. It takes the first column from SrcClm, finds the cell with the help of the provided row and pastes it to the first column from the DstClm array in the Fnd.Row row.
Example:- The first SrcClm is NdcG which was given a value of 7 (column G) in the enumeration. The first DstClmis NmcE which has a value of 5 (column E) in the enumeration. Now, presume instead of reading from column G you wanted to read from column H. So you start from the Enumeration. Change the assigned value from 7 to 8. Note that this change would automatically also change the value of NdcH. This is because NdcH as no value assigned to it which VBA understands to mean "next number". So, when you change NdcG to , NdcH will become 9 and you may have to change that, too.
After you change the value of NdcG the code will read from column H, just as you wanted, but the enumeration's name is wrong. Had we given descriptive names to the enumerations, like NdcName, NdcDob and NdcContractID this problem wouldn't exist. But as it is now NdcG must be changed to NdcH and you can't do that before you change the existing NdcH to NdcI.
Anyway, don't change the name in the enumeration. Instead, use Edit > Replace and replace all occurrences of NdcH with NdcI and, thereafter, all occurrences of NdcG to NdcH. All of this sounds complicated and it is that. You need to give your full attention to avoid mistakes.
Of course, in this way you can change any source or destination column in the system. It's not difficult and can be completed quite fast after you have done it once.