Copy rows by column match condition

The code below works thanks to a guy named "The Real Tin Tin" on another site. You need to change the "ABCDEFG" to whatever your column names are and also the column number they are in so for example Column G = 7 and Column E = 5. You also need to change the sheet names from "Master" and "Data" to whatever you named them. I have been trying to figure out how to get the rows to delete after it copies them. I will post that addition once I have it working flawlessly. I would like to see a excel community that shares knowledge so if you have a code that works please post it. I will keep doing the same and who knows we may help each other someday.



Option Explicit

Private Const MASTER_ABCDEFG_COL_IDX As Integer = 7
Private Const DATA_ABCDEFG_COL_IDX As Integer = 5

Public Sub FindMatchingData()
Dim MasterWrkSh As Worksheet
Dim MasterColCount As Integer
Dim MasterRowCount As Long
Dim MasterCol As Integer
Dim MasterRow As Long
Dim DataWrkSh As Worksheet
Dim DataColCount As Integer
Dim DataRowCount As Long
Dim DataRow As Long
Dim CopyData As Integer
Dim PrintData As Integer
Dim Data() As Variant

' Prevent ScreenUpdating and Alerts to improve performance while running.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Cursor = xlWait

' We use objects to store the WorkSheets we'll be working on to make altering the _
code easier if required.
Set MasterWrkSh = Sheets("Master")
Set DataWrkSh = Sheets("Data")

' Store the Row/Column limits. This prevents us from continuously checking these, _
improving performance.
MasterColCount = MasterWrkSh.UsedRange.Columns.Count
MasterRowCount = MasterWrkSh.UsedRange.Rows.Count
DataColCount = DataWrkSh.UsedRange.Columns.Count
DataRowCount = DataWrkSh.UsedRange.Rows.Count

' Prepare the dynamic array for data. If this is not done, the code will fall over.
ReDim Data(DataColCount, 0)

' These nested For loops, check each row on the Master and Data WorkSheets and _
compare the PSN columns. Where a match is found, the data for the equivalent _
row on the Data WorkSheet is stored in the Data array, which we will use later _
copy the data over to the Master WorkSheet.
For MasterRow = 1 To MasterRowCount
' These 2 lines simply update the StatusBar so the user knows what stage the _
"query" is at and also free's the CPU, preventing crashes and freezes should _
the user wish to cancel the code. _
NOTE: The running of the code can be cancelled by pressing Ctrl + Pause/Break.
Application.StatusBar = Format(MasterRow / MasterRowCount, "0 %")
DoEvents
For DataRow = 1 To DataRowCount
' This is the If statement that checks whether we have a match.
If MasterWrkSh.Cells(MasterRow, MASTER_PSN_COL_IDX) = _
DataWrkSh.Cells(DataRow, DATA_PSN_COL_IDX) Then
ReDim Preserve Data(DataColCount, UBound(Data, 2) + 1)
Data(0, UBound(Data, 2)) = MasterRow
For CopyData = 1 To DataColCount
Data(CopyData, UBound(Data, 2)) = DataWrkSh.Cells(DataRow, CopyData)
Next
' As we found a match, we can Exit the For loop as we don't need to check _
for further matches.
Exit For
End If
Next
Next

' Now we've compaired all the data we need to, these nested For loops will "paste" _
this data on the Master WorkSheet. _
NOTE: No StatusBar updates are provided during this process. If the process takes _
an excessive amount of time, it may be beneficial to change this.
For PrintData = 1 To UBound(Data, 2)
For MasterCol = 1 To UBound(Data, 1)
MasterWrkSh.Cells(Data(0, PrintData), MasterCol + MasterColCount) = Data(MasterCol, PrintData)
Next
Next

' Return full control to Excel and refresh the sheet.
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault

' Free up resources.
Set DataWrkSh = Nothing
Set MasterWrkSh = Nothing

End Sub