New Idea: A self-correcting Excel file
I did something I have never seen done before: I created a self-correcting spreadsheet.
In the last few weeks I've been working on generating a solution to pull together and print out state government regulations, covering certain topics such as minimum wage, meal and rest breaks, overtime, etc. My company probably pays to receive this data from another company and the data comes in download files where each regulation topic is summarized for all 50 states. For example, for minimum wage, there is a download file specifically on minimum wage and that file lists out the minimum wage rates for all 50 states, as well as some other regulations related to minimum wage. My HR VP wanted to make life easier for the managers out in the field and asked me to design a process that would create each state's report in an automatic fashion.
I've written a couple of posts about issues to overcome: 1) when states are not given as just states but "Oregon - rural counties" so a simple VLOOKUP won't work; 2) another example requiring arrays instead of VLOOKUPs; 3) when some cells of information contain embedded line breaks; 4) fixing your row heights when cells are merged; 5) printing out the report into PDF when one section requires repeating column headers but not all sections.
The above images pertains to recent posts on this topic. Click on the image to read the post.
I figured out all of the puzzles and created something where you start in the tab "StartHere", start pulling in the data, and then print out your choice of state reports. The image below is a screenshot the "StartHere" tab. You will see the highlighted "Pull In Data" button for collecting the data from the downloads. The great thing is if you don't need to update all of the regulations, then you do not need all of the downloads before you can run the "Pull In Data" program. The only caveat is the name of the download file must have a keyword in order for the program to recognize the download. A copy of the "Pull In Data" program (it's called "CopyData") can be found further below.
The other button, "Fix Errors" is the new thing - what I call the self-correcting program. The problem with developing this automated report is that I do not have a lot of examples of downloads, so I have no history of how the downloads could change. I talked to the HR VP and she said that these Excel downloads really do not change very frequently... With that in mind, I created some dummy changes of the types that were most likely to happen and those are the "errors" the self-correcting program addresses.
Snapshot of "StartHere" tab - how it looks before pulling in new data
I'm not going to go into all of the details of how this self-correcting program works but do want to provide some highlights to give ideas on what to do.
Below you will see 3 snapshots of how the error messages look plus a fourth picture of the "Tables" tab that is doing some checking of the data. Basically I am looking 1) for spelling errors; 2) for more rows of data required to display state's regulations than I have available in the report (the additional data fails to show up); and 3) for more rows of data than I have formulas in the download tabs. There are others but those are the main ones I want to talk about, just to give you an idea of how the self-correcting program works. The "StartHere" tab has formulas that checks the "Tables" tab for when something is going wrong and if something is wrong, flags the error as a red message. Then next to the red error message, instructions on what to do is provided - mostly to push the "Fix Error" button.
Snapshot 1 of error message
Snapshot 2 of error message
Part of spelling error message, displaying which state and which download data
Snapshot of "Tables" tab
[ap_divider color="#CCCCCC" style="solid" thickness="3px" width="100%" mar_top="20px" mar_bot="20px"]
The CopyData Program
[ap_divider color="#CCCCCC" style="solid" thickness="3px" width="100%" mar_top="20px" mar_bot="20px"]
This program basically goes through all of the open workbooks one by one and then tries to find a tab in the report file that has a portion of the file's name. So if you have a workbook called Final Wage Payment open and you have a tab called Final Wage Pay, then the program will know to associate the download workbook with the tab.
The next thing the program will do is see which holds more data - the workbook or the tab with prior data. The point is I don't want to copy the entire sheet of the workbook; I run the risk of exploding the file size. I want to copy just enough data. The variables irow and endmark plays that role.
[Sorry, this WordPress template won't allow me to indent the codes.]
Sub CopyData()
'Variables to hold copied data****************************************************************************************
Dim wbSource As Workbook 'Source will be those download data in various Excel files
Dim wbDest As Workbook 'Dest (destination) will be the tabs in this file
Dim rangetocopy As Range
Dim endmark As Long
'********************************************************************************************************************
'Other variables - basically for rolling through download files ("wb") and tabs ("tb")***********************************
Dim Sheets As Worksheet
Dim wb As Workbook
Dim FindCol As Variant
Dim ColNum As Integer
'*********************************************************************************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'Stop Excel from asking if we want to write over previous data
Set wbDest = ActiveWorkbook
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name And wb.Name <> "PERSONAL.XLSB" Then 'exclude these files ("personal" and "State Report") from the looping
Set wbSource = wb
wbSource.Activate
i = ActiveCell.SpecialCells(xlLastCell).Address(False, False) 'capture Ctrl+end
irow = ActiveCell.SpecialCells(xlLastCell).Row 'row number of wbSource (one of download files)
icol = ActiveCell.SpecialCells(xlLastCell).Column 'column number of wbSource
For Each Sheets In wbDest.Sheets 'go thru each tab in "State Report" and find one that matches the current download/wbSource
If wbSource.Name Like "*" & Sheets.Name & "*" Then
If irow + 10 <= wbDest.Sheets(Sheets.Name).Range("z1") Then 'if number of rows in tab is greater than the source, then want to copy as many rows as in tab (as a way of clearing out old data)
endmark = wbDest.Sheets(Sheets.Name).Range("z1") + 10 'done to maintain the copying area to be small enough without utilizing the entire tab method - could cause file size to blow up
End If
If irow + 10 > wbDest.Sheets(Sheets.Name).Range("z1") Then 'if number of rows in new data in download is greater than in tab, then copy as many rows in new data
endmark = irow + 10
End If
wbDest.Sheets(Sheets.Name).Range("z1") = irow + 10 'mark the new row number in cell "z1"
Set rangetocopy = wbSource.Sheets("Sheet1").Range(Cells(2, 1), Cells(endmark, icol)) 'copying from A1 to last row + 10
wbDest.Activate
Set FindCol = wbDest.Sheets(Sheets.Name).Range("1:1").Find(What:="State", LookIn:=xlValues) 'finding where to start the pasting - want to do it under "State" column
ColNum = FindCol.Column
wbDest.Sheets(Sheets.Name).Activate
rangetocopy.Copy wbDest.Sheets(Sheets.Name).Range(Cells(2, ColNum), Cells(2, ColNum)) 'pasting to 2nd row, under "State" column
End If
Next Sheets
End If
Next wb
Application.DisplayAlerts = True
Application.ScreenUpdating = True
wbDest.Sheets("StartHere").Activate
MsgBox ("Done!")
End Sub
[ap_divider color="#CCCCCC" style="solid" thickness="3px" width="100%" mar_top="20px" mar_bot="20px"]
FixErrors Program
[ap_divider color="#CCCCCC" style="solid" thickness="3px" width="100%" mar_top="20px" mar_bot="20px"]
This FixErrors program gets a bit more difficult to explain concisely what it is doing. It is basically checking to see if certain cells have "a" in them (visually, the "a" looks like a checkmark because the font is Webdings) and if it does, perform the "corrections". The corrections could be add additional rows in the Report template or copy formulas down the rows of additional data. This program is not a nice shrunken down program so it is longer - way longer.
Now there are a couple of things I should point out: 1) there are some sections that need finishing up or does not apply so they are incomplete (step 3 and error handling are good examples); 2) there are some repetitive elements in each step so I colored those codes in blue; 3) STEP 1 is to make sure there are enough rows of formulas to cover all of the data in the download tabs; 4) STEP 2 inserts additional rows into the report (called the "Template" tab) and copies down the appropriate formulas; and STEP 4 makes sure all formulas referencing other tabs covers enough rows of data (currently it is set to 500 rows so it is unlikely I will need to do STEP 4).
Sub FixErrors()
'STEP 1 Variables***************************************************************************************************
Dim FormRow As Integer
Dim DataRow As Integer
'*******************************************************************************************************************
'STEP 2 Variables***************************************************************************************************
Dim AddRows As Integer
Dim FindRow As Variant
Dim RowNum As Integer
'*******************************************************************************************************************
'STEP 4 Variables***************************************************************************************************
Dim OldMaxRef As Integer
Dim NewMaxRef As Integer
'*******************************************************************************************************************
'Filtering Variables************************************************************************************************
Dim FilterEnd As Integer
Dim FindEnd As Variant
Set FindEnd = Sheets("Template").Range("B:B").Find(What:="end", LookIn:=xlValues)
FilterEnd = FindEnd.Row
'*******************************************************************************************************************
'Other Generic Variables********************************************************************************************
'Used for finding phrases and noting location in error section - I keep moving this section around so having
' a specific cell address no longer works - I need it to be self-adjustable.
Dim FindPhrase As Variant
Dim RowLoc As Integer
Dim ColLoc As Integer
'*******************************************************************************************************************
'Error Handling*******************************************************************************************************
On Error GoTo ErrorHandling
'**********************************************************************************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'Stop Excel from asking if we want to write over previous data
'STEP 1: Make sure that for those tabs with formulas, there are enough formulas covering all of the rows of data
' 1a: Minimum Wage
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Min Wage needs more", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Minimum Wage").Activate
FormRow = Sheets("Tables").Range("R16")
DataRow = Sheets("Tables").Range("S16")
Sheets("Minimum Wage").Range(Cells(FormRow, 1), Cells(FormRow, 5)).Select
Selection.Copy
Sheets("Minimum Wage").Range(Cells(FormRow + 1, 1), Cells(DataRow, 5)).Select
ActiveSheet.Paste
End If
' 1b: Final Wage
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Final Wage Pay needs", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Final Wage Pay").Activate
FormRow = Sheets("Tables").Range("R17")
DataRow = Sheets("Tables").Range("S17")
Sheets("Final Wage Pay").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("Final Wage Pay").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
' 1c: Overtime
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Overtime needs", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Overtime").Activate
FormRow = Sheets("Tables").Range("R18")
DataRow = Sheets("Tables").Range("S18")
Sheets("Overtime").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("Overtime").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
' 1c: New Hire Paperwork
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="New Hire needs", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("New Hire Paperwork").Activate
FormRow = Sheets("Tables").Range("R19")
DataRow = Sheets("Tables").Range("S19")
Sheets("New Hire Paperwork").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("New Hire Paperwork").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
' 1c: Off-Duty Behavior
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Off Duty needs more", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Off-Duty Behavior").Activate
FormRow = Sheets("Tables").Range("R20")
DataRow = Sheets("Tables").Range("S20")
Sheets("Off-Duty Behavior").Range(Cells(FormRow, 1), Cells(FormRow, 2)).Select
Selection.Copy
Sheets("Off-Duty Behavior").Range(Cells(FormRow + 1, 1), Cells(DataRow, 2)).Select
ActiveSheet.Paste
End If
' 1d: Meal and Rest Break
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Meal and Rest Breaks", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Meal and Rest Break").Activate
FormRow = Sheets("Tables").Range("R21")
DataRow = Sheets("Tables").Range("S21")
Sheets("Meal and Rest Break").Range(Cells(FormRow, 1), Cells(FormRow, 2)).Select
Selection.Copy
Sheets("Meal and Rest Break").Range(Cells(FormRow + 1, 1), Cells(DataRow, 2)).Select
ActiveSheet.Paste
End If
' 1e: EEO
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="EEO needs more", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("EEO Protected Classes").Activate
FormRow = Sheets("Tables").Range("R22")
DataRow = Sheets("Tables").Range("S22")
Sheets("EEO Protected Classes").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("EEO Protected Classes").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
' 1f: Driving
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Driving needs more", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Driving").Activate
FormRow = Sheets("Tables").Range("R23")
DataRow = Sheets("Tables").Range("S23")
Sheets("Driving").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("Driving").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
' 1g: Pregnancy
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="Pregnancy needs more", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
Sheets("Pregnancy").Activate
FormRow = Sheets("Tables").Range("R24")
DataRow = Sheets("Tables").Range("S24")
Sheets("Pregnancy").Range(Cells(FormRow, 1), Cells(FormRow, 1)).Select
Selection.Copy
Sheets("Pregnancy").Range(Cells(FormRow + 1, 1), Cells(DataRow, 1)).Select
ActiveSheet.Paste
End If
'STEP 2: Add extra rows in "Template" for those instances when states have more regs
' Activate "Template" tab. Without it, the selection of rows to be added does not work
Sheets("Template").Activate
' First unfilter "Template"
Sheets("Template").Range(Cells(7, 1), Cells(FilterEnd + 10, 1)).AutoFilter Field:=1
' 2a: Minimum Wage
' Want to insert just before the last row of formulas for "Minimum Wage" section in "Template" tab
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="# of rows in Min Wage", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
AddRows = Sheets("Tables").Range("S2") - Sheets("Tables").Range("R2")
Set FindRow = Sheets("Template").Range("B:B").Find(What:="mwe", LookIn:=xlValues)
RowNum = FindRow.Row
' Insertion point
Sheets("Template").Activate
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' Copying formulas down
Sheets("Template").Rows(RowNum - 1 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
End If
' 2b: Final Wage - Not applicable
' 2c: Off-Duty Behavior
' Want to insert just before the last row of formulas for "Off-Duty Behavior" section in "Template" tab
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="# of rows in Off Duty", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
AddRows = Sheets("Tables").Range("S6") - Sheets("Tables").Range("R6")
Set FindRow = Sheets("Template").Range("B:B").Find(What:="ode", LookIn:=xlValues)
RowNum = FindRow.Row
' Insertion point
Sheets("Template").Activate
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' Copying formulas down
Sheets("Template").Rows(RowNum - 1 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
' Need to fix the HiddenTemplate for row height purposes
Sheets("HiddenTemplate").Visible = True
Set FindRow = Sheets("HiddenTemplate").Range("B:B").Find(What:="ode", LookIn:=xlValues)
RowNum = FindRow.Row
Sheets("HiddenTemplate").Activate
Sheets("HiddenTemplate").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("HiddenTemplate").Rows(RowNum - 1 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("HiddenTemplate").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
Sheets("Template").Activate
Sheets("HiddenTemplate").Visible = False
End If
' 2d: Meal and Rest Break
' Want to insert just before the last row of formulas for "Meal and Rest Break" section in "Template" tab
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="# of rows in Meal & Rest", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
AddRows = Sheets("Tables").Range("S7") - Sheets("Tables").Range("R7")
Set FindRow = Sheets("Template").Range("B:B").Find(What:="mre", LookIn:=xlValues)
RowNum = FindRow.Row
' Insertion point
Sheets("Template").Activate
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' Copying formulas down
Sheets("Template").Rows(RowNum - 1 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
' Need to fix the HiddenTemplate for row height purposes
Sheets("HiddenTemplate").Visible = True
Set FindRow = Sheets("HiddenTemplate").Range("B:B").Find(What:="mre", LookIn:=xlValues)
RowNum = FindRow.Row
Sheets("HiddenTemplate").Activate
Sheets("HiddenTemplate").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("HiddenTemplate").Rows(RowNum - 1 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("HiddenTemplate").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
Sheets("Template").Activate
Sheets("HiddenTemplate").Visible = False
End If
' 2e: EEO
' Want to insert just before the last row of formulas for "Meal and Rest Break" section in "Template" tab
' But EEO is going to require a different copying and pasting strategy due to the nature of its layout.
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="# of rows in EEO", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
AddRows = (Sheets("Tables").Range("S8") - Sheets("Tables").Range("R8")) * 10
Set FindRow = Sheets("Template").Range("B:B").Find(What:="eee", LookIn:=xlValues)
RowNum = FindRow.Row
' Insertion point
Sheets("Template").Activate
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' Copying formulas down
Sheets("Template").Rows(RowNum - 10 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("Template").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
' Need to fix the HiddenTemplate2 for row height purposes
Sheets("HiddenTemplate2").Visible = True
Set FindRow = Sheets("HiddenTemplate2").Range("B:B").Find(What:="eee", LookIn:=xlValues)
RowNum = FindRow.Row
Sheets("HiddenTemplate2").Activate
Sheets("HiddenTemplate2").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("HiddenTemplate2").Rows(RowNum - 10 & ":" & (RowNum - 1)).Select
Selection.Copy
Sheets("HiddenTemplate2").Rows(RowNum & ":" & (RowNum + AddRows - 1)).Select
ActiveSheet.Paste
Sheets("Template").Activate
Sheets("HiddenTemplate2").Visible = False
End If
' Filter "Template" tab again
Sheets("Template").Activate
Sheets("Template").Range(Cells(7, 1), Cells(FilterEnd + 10, 1)).AutoFilter Field:=1, Criteria1:="<>x"
'STEP 3: Additional notes
'STEP 4: Update formulas in "Template" tab to increase the rows referenced in the formulas (the formulas that call in data from the download tabs)
Set FindPhrase = Sheets("StartHere").Range("Q:Q").Find(What:="rows of data", LookIn:=xlValues)
RowLoc = FindPhrase.Row
ColLoc = FindPhrase.Column + 1
Sheets("StartHere").Activate
If Sheets("StartHere").Range(Cells(RowLoc, ColLoc), Cells(RowLoc, ColLoc)) = "a" Then
OldMaxRef = Sheets("StartHere").Range("Q46")
NewMaxRef = WorksheetFunction.Max(Sheets("Tables").Range("U16:U24")) + 100
' Now to get ready to find and replace with a new maximum range in the formulas (replace OldMaxRef with NewMaxRef)
' First, unfilter "Template" tab
Sheets("Template").Activate
Sheets("Template").Range(Cells(7, 1), Cells(FilterEnd + 10, 1)).AutoFilter Field:=1
' Now perform find and replace
Cells.Select
Selection.Replace What:=OldMaxRef, Replacement:=NewMaxRef, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Now filter back up "Template"
Sheets("Template").Range(Cells(7, 1), Cells(FilterEnd + 10, 1)).AutoFilter Field:=1, Criteria1:="<>x"
' Need to also do it in the "Tables" tab
Sheets("Tables").Activate
Cells.Select
Selection.Replace What:=OldMaxRef, Replacement:=NewMaxRef, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
' Go back to where you started from
Sheets("StartHere").Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Application.EnableEvents = True
MsgBox ("Done!")
CleanUp:
On Error Resume Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ErrorHandling:
'Think of something
GoTo CleanUp
End Sub
[ap_divider color="#CCCCCC" style="solid" thickness="3px" width="100%" mar_top="20px" mar_bot="20px"]
Okay, I'm going to stop here. It's been four hours writing this post and it's long enough. Time to do errands.
You must be logged in to post a comment.