Tutorial Resources:
https://excelmacromastery.com/excel-vba-find/
Toolbox
Set Date String (mmddyy)
sMyDate = Format(Month(Now), "00") & Format(Day(Now), "00") & Right(Year(Now), 2)
Click here for (messy) assembly of useful tools
sMyDate = Format(Month(Now), "00") & Format(Day(Now), "00") & Right(Year(Now), 2)
Click here for (messy) assembly of useful tools
Force String Type:
Use Cstr(myString) to convert an Object to String Type
(Useful for matching - especially when comparing 2 different object types.)
(Useful for matching - especially when comparing 2 different object types.)
Load Array:
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iCe1+1).Address, Worksheets(Ws1).Cells(iRe1, iCe1+1).Address)
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iCe1+1).Address, Worksheets(Ws1).Cells(iRe1, iCe1+1).Address)
'===================================================================================================
Dump Array:
'Dump the Results (Hard Coded WS/Cell location)
'===================================================================================================
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iCe1+1).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'===================================================================================================
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iCe1+1).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
Basic Framework of Page Review - Match and Respond
Sub BasicTemplate()
Dim Ws1 As Long, iRe1 As Long, iCe1 As Long, iLoop As Long, aData() As Variant, iColReview As Long, iColCopy As Long
Dim Ws2 As Long, iRe2 As Long, iCe2 As Long, aDump() As Variant, iColDump As Long
Erase aData: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = Worksheets("Sheet1").Index
iRe1 = Range(GetLastCell(Ws1)).Row
iCe1 = Range(GetLastCell(Ws1)).Column
Ws2 = Worksheets("Sheet2").Index
iRe2 = Range(GetLastCell(Ws2)).Row
iCe2 = Range(GetLastCell(Ws2)).Column
iColCopy = 1
iColReview = 2
iColDump = iCe1 + 1
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Test Headers to ensure they were found:
If iColReview = 0 Or iColDump = 0 Or iColCopy = 0 Then GoTo gHeaderIssueAbandonAllHope
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1 + 1).Address)
'===================================================================================================
'===================================================================================================
For iLoop = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'code goes here
Next iLoop
'===================================================================================================
'===================================================================================================
'Update header for Dump column (x1)
aDump(1, 1) = "Dump Val"
'Dump Results:
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
GoTo gReleaseMemory
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
gHeaderIssueAbandonAllHope:
MsgBox "Required Column not set - nothing happened"
GoTo gReleaseMemory
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
gReleaseMemory:
Erase aData: Erase aDump
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
MsgBox "Done"
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Sub
Dim Ws1 As Long, iRe1 As Long, iCe1 As Long, iLoop As Long, aData() As Variant, iColReview As Long, iColCopy As Long
Dim Ws2 As Long, iRe2 As Long, iCe2 As Long, aDump() As Variant, iColDump As Long
Erase aData: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = Worksheets("Sheet1").Index
iRe1 = Range(GetLastCell(Ws1)).Row
iCe1 = Range(GetLastCell(Ws1)).Column
Ws2 = Worksheets("Sheet2").Index
iRe2 = Range(GetLastCell(Ws2)).Row
iCe2 = Range(GetLastCell(Ws2)).Column
iColCopy = 1
iColReview = 2
iColDump = iCe1 + 1
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Test Headers to ensure they were found:
If iColReview = 0 Or iColDump = 0 Or iColCopy = 0 Then GoTo gHeaderIssueAbandonAllHope
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1 + 1).Address)
'===================================================================================================
'===================================================================================================
For iLoop = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'code goes here
Next iLoop
'===================================================================================================
'===================================================================================================
'Update header for Dump column (x1)
aDump(1, 1) = "Dump Val"
'Dump Results:
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
GoTo gReleaseMemory
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
gHeaderIssueAbandonAllHope:
MsgBox "Required Column not set - nothing happened"
GoTo gReleaseMemory
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
gReleaseMemory:
Erase aData: Erase aDump
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
MsgBox "Done"
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Sub
Last Row / Last Column: (cell.end method)
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
dim Ws1 as long, iRe1 as long, iCe1 as long
Ws1 = Worksheets("Sheet1").Index
iRe1 = Worksheets(Ws1).Cells(1048576, 1).End(xlUp).Row
iCe1 = Worksheets(Ws1).Cells(1, 16384).End(xlToLeft).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
dim Ws1 as long, iRe1 as long, iCe1 as long
Ws1 = Worksheets("Sheet1").Index
iRe1 = Worksheets(Ws1).Cells(1048576, 1).End(xlUp).Row
iCe1 = Worksheets(Ws1).Cells(1, 16384).End(xlToLeft).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Split Method:
This method uses a Concatenated String (Separated by the "^" delimiter) along with the Split Function to create a set of Standard Headers.
Click Here for sample code
Click Here for sample code
MatchKeys: 1
Click here for 1 method of matching data
MatchKeys: 2
Click here for another method of matching data
Rept Function:
Click Here for visual explanations on using the Rept function in some unusual but useful ways.