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, iDumpColCount As Long
Dim Ws2 As Long, iRe2 As Long, iCe2 As Long, aDump() As Variant, iColDump As Long
Dim aSplitMe As Variant, iNextRow As Long, iSplitLoop As Long
Erase aData: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = ActiveSheet.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
iColReview = Application.InputBox(Prompt:="What[Column] contains the data to review?", Title:="Specify Column by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
'iColCopy = 2
iDumpColCount = 4
iColDump = iCe1 + 1
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Test Headers to ensure they were found:
If iColReview = 0 Or iColDump = 0 Then GoTo gHeaderIssueAbandonAllHope
'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)
'note: to get the ubound of the dump, manually did find/replace for delimiter - noted count, then manually entered result below
aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1 + 2396, iCe1 + iDumpColCount).Address)
'aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1 + iDumpColCount).Address)
'===================================================================================================iNextRow = 1
'===================================================================================================
For iLoop = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'code goes here
aSplitMe = Split(aData(iLoop, iColReview), "^")
For iSplitLoop = LBound(aSplitMe) To UBound(aSplitMe)
iNextRow = iNextRow + 1
aDump(iNextRow, 1) = aSplitMe(iSplitLoop)
Next iSplitLoop
Erase aSplitMe
Next iLoop
'===================================================================================================
'===================================================================================================
'Update header for Dump column (x1)
aDump(1, 1) = "Dump Val"
'aDump(1, 1) = InputBox("Enter the header you want to use to label this dataset")
'Dump Results:
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iColDump).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, iDumpColCount As Long
Dim Ws2 As Long, iRe2 As Long, iCe2 As Long, aDump() As Variant, iColDump As Long
Dim aSplitMe As Variant, iNextRow As Long, iSplitLoop As Long
Erase aData: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = ActiveSheet.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
iColReview = Application.InputBox(Prompt:="What[Column] contains the data to review?", Title:="Specify Column by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
'iColCopy = 2
iDumpColCount = 4
iColDump = iCe1 + 1
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Test Headers to ensure they were found:
If iColReview = 0 Or iColDump = 0 Then GoTo gHeaderIssueAbandonAllHope
'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)
'note: to get the ubound of the dump, manually did find/replace for delimiter - noted count, then manually entered result below
aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1 + 2396, iCe1 + iDumpColCount).Address)
'aDump = Range(Worksheets(Ws1).Cells(1, iCe1 + 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1 + iDumpColCount).Address)
'===================================================================================================iNextRow = 1
'===================================================================================================
For iLoop = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " of " & UBound(aData)
'code goes here
aSplitMe = Split(aData(iLoop, iColReview), "^")
For iSplitLoop = LBound(aSplitMe) To UBound(aSplitMe)
iNextRow = iNextRow + 1
aDump(iNextRow, 1) = aSplitMe(iSplitLoop)
Next iSplitLoop
Erase aSplitMe
Next iLoop
'===================================================================================================
'===================================================================================================
'Update header for Dump column (x1)
aDump(1, 1) = "Dump Val"
'aDump(1, 1) = InputBox("Enter the header you want to use to label this dataset")
'Dump Results:
Worksheets(Ws1).Select
'Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, iColDump).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