Loop through a List - Apply a Match/Function
Sub ListReview()
Dim iCe1 As Long, iRe1 As Long, iLoop As Long, aData() As Variant, aDump() As Variant, iColReview As Long, iColDump As Long, Ws1 As Long
Dim sTemp As String, sCheck As String, iLenR As Long
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = ActiveSheet.Index
iRe1 = Cells(1048576, 1).End(xlUp).Row
iCe1 = Cells(1, 300).End(xlToLeft).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'===================================================================================================
'Get user input for 1) Column Review 2) Column Dump
iColReview = Application.InputBox(Prompt:="Which column contains the DATA to [Review]?", Title:="Specify Column by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
iColDump = Application.InputBox(Prompt:="Which column do you want to [Dump] results into?", Title:="Specify Column by Clicking on ANY Cell.", Default:=Cells(1, iCe1).Address, Type:=8).Column
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iColDump).Address, Worksheets(Ws1).Cells(iRe1, iColDump).Address)
'===================================================================================================
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'Value to look for
sCheck = UCase(aData(1, iColDump))
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Loop Through data
For iLoop = LBound(aData) + 1 To UBound(aData)
'------------------------------------------------------------------------------------
'Enable Pause + Keep user updated with progress
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------
'BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
'Value to compare to
sTemp = UCase(aData(iLoop, iColReview))
'BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
'Create a visual marker to show match was found
If Right(sTemp, Len(sCheck)) = sCheck Then aDump(iLoop, 1) = "X"
'------------------------------------------------------------------------------------
Next iLoop
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'===================================================================================================
'Add Header
aDump(1, 1) = sCheck
'===================================================================================================
'Dump Results
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, iColDump).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'==================================================================================================================
gMemoryCleanup:
Application.StatusBar = "": Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
Erase aDump: Erase aData
MsgBox "Done"
'==================================================================================================================
End Sub
Dim iCe1 As Long, iRe1 As Long, iLoop As Long, aData() As Variant, aDump() As Variant, iColReview As Long, iColDump As Long, Ws1 As Long
Dim sTemp As String, sCheck As String, iLenR As Long
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = ActiveSheet.Index
iRe1 = Cells(1048576, 1).End(xlUp).Row
iCe1 = Cells(1, 300).End(xlToLeft).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'===================================================================================================
'Get user input for 1) Column Review 2) Column Dump
iColReview = Application.InputBox(Prompt:="Which column contains the DATA to [Review]?", Title:="Specify Column by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
iColDump = Application.InputBox(Prompt:="Which column do you want to [Dump] results into?", Title:="Specify Column by Clicking on ANY Cell.", Default:=Cells(1, iCe1).Address, Type:=8).Column
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iColDump).Address, Worksheets(Ws1).Cells(iRe1, iColDump).Address)
'===================================================================================================
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'Value to look for
sCheck = UCase(aData(1, iColDump))
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Loop Through data
For iLoop = LBound(aData) + 1 To UBound(aData)
'------------------------------------------------------------------------------------
'Enable Pause + Keep user updated with progress
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------
'BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
'Value to compare to
sTemp = UCase(aData(iLoop, iColReview))
'BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
'Create a visual marker to show match was found
If Right(sTemp, Len(sCheck)) = sCheck Then aDump(iLoop, 1) = "X"
'------------------------------------------------------------------------------------
Next iLoop
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'===================================================================================================
'Add Header
aDump(1, 1) = sCheck
'===================================================================================================
'Dump Results
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, iColDump).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'==================================================================================================================
gMemoryCleanup:
Application.StatusBar = "": Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
Erase aDump: Erase aData
MsgBox "Done"
'==================================================================================================================
End Sub