Hello, is there anyway to make this code more efficient? It goes through over 6000 rows of data (people) and I am adding more people to the table. At present, it takes a long time to do it.
Thanks,
Thanks,
VBA Code:
Sub Match_Data_and Replace()
Dim Data As Worksheet
Dim List As Worksheet
Set Data = ThisWorkbook.Sheets("Patient_Data") ' Raw Data
Set List = ThisWorkbook.Sheets("Wrk_List") ' Search Data - Wrk_List
Dim dArray() As String
Dim lArray() As String
ReDim Preserve dArray(1 To Data.Range("A" & Rows.Count).End(xlUp).Row, 1 To 34)
ReDim Preserve lArray(1 To List.Range("A" & Rows.Count).End(xlUp).Row, 1 To 34)
For a = 1 To Data.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To 34
dArray(a, b) = Data.Cells(a, b)
Next b
Next a
For a = 1 To List.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To 34
lArray(a, b) = List.Cells(a, b)
Next b
Next a
Dim MRN As String, lName As String
For a = 2 To UBound(lArray)
MRN = lArray(a, 1)
lName = lArray(a, 2)
For b = 2 To UBound(dArray)
If dArray(b, 1) = MRN And dArray(b, 4) = lName Then
dArray(b, 3) = lArray(a, 3) ' f_Name
dArray(b, 4) = lArray(a, 6)
dArray(b, 6) = lArray(a, 7) ' Phone
dArray(b, 7) = lArray(a, 5)
dArray(b, 36) = lArray(a, 13)
dArray(b, 37) = lArray(a, 14)
dArray(b, 38) = lArray(a, 15)
dArray(b, 39) = lArray(a, 16)
dArray(b, 40) = lArray(a, 17)
dArray(b, 41) = lArray(a, 18)
Exit For
End If
Next b
Next a
'Transfer data back
For a = 2 To UBound(dArray)
For b = 2 To 34
Data.Cells(a, b).Value = dArray(a, b)
Next b
Next a
End Sub
