Help selecting variable range for cut and paste

[knittelmail]

I am trying to automate/speed up the process of combining information from two worksheets. Sheet A is a report generated by software. Sheet B is filled with formulas that I want to use on the information in Sheet A. As background, I think Sheet A was created by the devil. It has multiple ranges of merged cells, it has loads of wrapped text, and cells that look empty but have space characters in them. The row heights are also set at a standard row height that hides some of the text in the wrapped cells. I can fix all of that, but...

What I am having trouble with is the variable row location of the ranges I want to select. There are several ranges in Sheet A. They don't always start or end in the same place. The number of columns across is always the same, but the number of rows in each row can change. This means I can't do a straight copy and paste. For example:

The range including A1 might have 3 rows or it might have 10. The number of rows in the first range changes the starting location of the next range and so on down the column. Please pretend that column C is a new instance of column A

Sheet A or Sheet B can be modified so that the rows line up, but I have to do it manually each time. Running a module would be a lot easier and faster.
My thinking is that on Sheet A, I can count the number of occupied cells between the empty cells then subtract that number from a set number of rows in Sheet B (say 20) and insert that number of rows to make everything line up for relatively simple cut and paste.
Can anyone point me in the right direction?
Thank you all very much!

 

[OaklandJim]

I'm still working on it! I'm not clear about how the Final worksheet is used? Do I need to construct that one?

Might you post a copy of the Formulas1 worksheet that includes the formulas in columns O to AO?

Here is what I have so far. Move (copy) the top part of the Report to a separate/new worksheet named Input. Once done filling that in (like in the past) there is code to make a copy of that range and paste it into the Report sheet or the Formulas sheet as a picture that looks just like the source range but is a static object that cannot be edited. Only the range in the Input worksheet can be modified (then recopied into Report of Formulas worksheets as a picture). Looks great to me. I have code that removes all merged cells in Report. Code also copies all Menu items, from the Report worksheet, for each station, to the Formulas worksheet. I'll be gone until next Monday.

I wish that I could post a link to the interim version of the workbook but rules forbid doing that unless all code is posted too.

Moderator: might I be allowed to post a link to an INTERIM version of the workbook for review -- and probably an iteration or two -- without code if I promise to post code when the FINAL version is posted?

 

[knittelmail]

I put lipstick on the pig. It isn't pretty, but it worked when I left work. I pray it will work again tomorrow. I am positive you can clean it and make it a lot better than I can do.
Hopefully this answers your questions. Please let me know if you have anymore for me.
Thank you again for looking at this monster.

I ended up with a lot of little macros stuck in one big macro which is ,I am sure, not the best way to do it for lots of reasons. Here is a link to a folder with the macros.

Macros

Shared with Dropbox

www.dropbox.com

I take the workbook named Report and smash it together with the workbook named Revised Formula sheet.
The Report as I get it. The raw data not produced by me.

Report.xlsm

Shared with Dropbox

www.dropbox.com

The Revised Formula Sheet showing the formulas that have to stay.

Revised Formula Sheet Showing Formulas.xlsm

Shared with Dropbox

www.dropbox.com

The same sheet with the formulas hidden.

Revised Formula Sheet.xlsm

Shared with Dropbox

www.dropbox.com

Here is an example of my finished end goal sheet. The "form" I fill out.

May 25 production record.xlsm

Shared with Dropbox

www.dropbox.com

After I get the sheets mashed together, I then generate another report that gives me the number I put into the "form" created by the merger. Just so you can see it, here is that report too.

summary.fop.pdf

Shared with Dropbox

www.dropbox.com

 

[OaklandJim]

This will be a big challenge. What I have now eliminates the empty columns in the report and formulas sheet. Now I see that there are formulas in otherwise empty columns (i.e., columns that do not have data from the Report). It also seems that each meal type will have different formulas. I'll see if I can handle all of the formulas in the area where menu items are. It'll take a while. I hope that I can figure out a way to do this. I might screw up a few formulas that you might have to correct.

 

[OaklandJim]

Here is the deal. A moderator has authorized direct communication between us so the interaction can be more effective. I am hacking my way through the Formulas sheet and if I'm going to try to figure out a way to work with it I'll want to discuss it. What time zone? I'm in the Pacific time zone. What are good times to talk by phone?

 

[knittelmail]

I am in the Central time zone so you are two hours earlier than me. Most weekdays from about 3:00 - 5:00pm CST (1:00 - 3:00pm PST) are good for me. I don't have access to excel with VBA at home so I have to be at work. I work in a school district and most of my mornings are spent away from my computer.

What times are best for you? If we schedule the call in advance, I can probably work with your availability. Do you have a way to share phone numbers without giving them to the entire forum?

 

[OaklandJim]

I'm a bit under the weather hence the silence.

I will observe that my attempt to untangle the formulas -- so I can get the data from Report into the Formulas worksheet -- was only partially successful. There are a few formulas and labels that I am trying hard to work around. It may be that you'll have to recreate some formulas. I'd say I got 80% there but I'm kind of stuck right now.

I am curious to know how much time you have to spend on this each day?

 

[knittelmail]

Problem is resolved.
Thank you OaklandJim! I could not have done it without you,

 

[OaklandJim]

Here is the code.

'Use to render the error messages from error handler.
Function ErrorMessage( _
    pErrNum As Integer, _
    psErrDescr, _
    Optional psSubName = "", _
    Optional psStepID = "")
    
'    If pErrNum = 18 Then Exit Function

    Dim sMsg As String
        
    Dim sTitle As String
    
    sTitle = "Error Message"
    
    sMsg = "Error #" & pErrNum & " occurred"
    
    If psSubName <> "" _
     Then sMsg = sMsg & Chr(10) & "in procedure " & psSubName
    
    sMsg = sMsg & "."
    
    If psStepID <> "" _
     Then sMsg = sMsg & Chr(10) & "Step ID: " & psStepID & "."
    
    sMsg = sMsg & Chr(10) & "Error Type: " & psErrDescr & "."
    
    MsgBox sMsg, vbOKOnly + vbCritical, sTitle
    
    Err.Clear
    
    Application.StatusBar = False
    DoEvents

End Function
'

' ----------------------------------------------------------------
' Procedure Name: GetFileName
' Purpose: Allow user to point to a file (name).
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psPathAndFile (String): The path and file are returned to caller in this ByRef parameter.
' Parameter psStartPath (String): The start path.
' Parameter psFilterName (String): The file-to-select name filter.
' Parameter psFilter (String): The file-to-select file name extension filter.
' Parameter psTitle (String): Title for the dialog box.
' Author: Jim
' Date: 8/24/2023
' ----------------------------------------------------------------

Function GetFileName( _
    ByRef psPathAndFile As String, _
    ByVal psStartPath As String, _
    Optional ByVal psFilterName As String = "Any file", _
    Optional ByVal psFilter As String = "*.xl*?", _
    Optional ByVal psTitle As String = "Select a file.")

    Dim fdGetFileName As Office.FileDialog
    
    Dim vAns As Variant
    
    Set fdGetFileName = Application.FileDialog(msoFileDialogFilePicker)
    
DoGetFile:
    
    With fdGetFileName
    
        .Filters.Clear
        
        .Filters.Add psFilterName, psFilter, 1
        
        .Title = psTitle
        
        .AllowMultiSelect = False
    
        .InitialFileName = psStartPath
    
        If .Show = True Then
    
            psPathAndFile = .SelectedItems(1)
            
            Exit Function
            
        Else
        
            vAns = MsgBox("Please select a file.", vbOKCancel + vbQuestion, "Selecting a folder containing PDFs to Print")

            If vAns = vbOK Then GoTo DoGetFile
    
        End If
    
    End With

End Function

' ----------------------------------------------------------------
' Procedure Name: GetFormulasRowsData
' Purpose: Count menu item rows for each station.
' Procedure Kind: Function
' Procedure Access: Public
' ByRef Parameter paiNumberRows (Long): Array holding first row and row count for each station.
' Return Type: Long)
' Author: Jim
' Date: 8/5/2023
' ----------------------------------------------------------------

Function GetFormulasRowsData(ByRef pavAnchorRows() As Variant)
'
    Dim iLastRow As Long
    
    Dim iRow As Long
    
    Dim iStationsCount As Long
    
    Dim iStation As Long
    
    ReDim pavAnchorRows(1 To 2, 1)

    With Worksheets("Formulas")
        
        iLastRow = .Range("B1").Cells(Rows.Count, 1).End(xlUp).Row
        
        For iRow = 1 To iLastRow
            If .Range("B1").Cells(iRow).value = "Recipe #" _
             Then
                iStationsCount = iStationsCount + 1
                
                ReDim Preserve pavAnchorRows(1 To 2, iStationsCount)
                
'               Save station anchor row value to the array.
                pavAnchorRows(1, iStationsCount) = iRow

            End If

        Next iRow

'       Get row counts. Put them into the array.
        For iStation = 1 To UBound(pavAnchorRows, 2)

            iRow = 0

            With .Range("A1").Cells(pavAnchorRows(1, iStation))

                Do
                    iRow = iRow + 1

                Loop Until Trim(.Offset(iRow)) = ""

'               Save station rows count to the array.
                pavAnchorRows(2, iStation) = iRow - 1
                
            End With

        Next iStation
        
    End With 'Worksheets("Report")
    
End Function



' ----------------------------------------------------------------
' Procedure Name: GetReportStationsData
' Purpose: Count menu item rows for each station.
' Procedure Kind: Function
' Procedure Access: Public
' ByRef Parameter pavNumberRows (Long): Array holding first row and row count for each station.
' Return Type: Long)
' Author: Jim
' Date: 8/5/2023
' ----------------------------------------------------------------

Function GetReportStationsData(ByRef pavNumberRows() As Variant, Optional ByVal iColOffset As Long = 0)
'
    Dim iLastRow As Long
    
    Dim iRow As Long
    
    Dim iStation As Long
    
    ReDim pavNumberRows(1 To 3, 1)

    With Worksheets("Report")
        
        iLastRow = .Range("A1").Cells(Rows.Count, 1).End(xlUp).Row
        
        For iRow = 1 To iLastRow
            If .Range("A1").Offset(0, iColOffset).Cells(iRow).value = "Recipe #" _
             Then
                iStation = iStation + 1
                
                ReDim Preserve pavNumberRows(1 To 3, iStation)
                
'               Save station anchor cell row to the array
                pavNumberRows(1, iStation) = iRow + 1

            End If
            
        Next iRow

'       Get row counts and station names. Put them into the array.
        For iStation = 1 To UBound(pavNumberRows, 2)

            iRow = 0

            With .Range("A1").Cells(pavNumberRows(1, iStation))

                Do
                    iRow = iRow + 1

                Loop Until Trim(.Offset(iRow)) = ""

'               Save station rows count to array.
                pavNumberRows(2, iStation) = iRow

'               Save station name to array.
                pavNumberRows(3, iStation) = .Offset(-2, 1).value

            End With

        Next iStation
        
    End With 'Worksheets("Report")
    
End Function


' ----------------------------------------------------------------
' Procedure Name: GetStationNames
' Purpose: Get list of stations as a comma separated string. Used
'          to get the list of stations for the Formulas top (picture).
' Procedure Kind: Function
' Procedure Access: Public
' Author: Jim
' Date: 8/30/2023
' ----------------------------------------------------------------
Function GetStationNames()

    Dim sStationsNamesList As String
    
    Dim sStationName As String
    
    Dim iStationsCount As Long
    
    Dim iStation As Long
    
    iStationsCount = 9
    
    GetStationNames = "none"
    
    For iStation = 1 To iStationsCount
        
        sStationName = [Formulas].Range("Station" & iStation & "Name")

        If UCase(sStationName) <> "NOT USED" And sStationName <> "" _
        Then
            If sStationsNamesList <> "" And iStation < iStationsCount _
             Then sStationsNamesList = sStationsNamesList & ", "

             sStationsNamesList = sStationsNamesList & Application.WorksheetFunction.Proper(sStationName)

        End If
        
    Next
    
    GetStationNames = sStationsNamesList
    
End Function



' ----------------------------------------------------------------
' Procedure Name: CreateFormulasTop
' Purpose: Create the picture for the top of the formulas worksheet (report).
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 8/31/2023
' ----------------------------------------------------------------

Sub CreateFormulasTop()

    Dim pPicTop As Picture
    
    Dim sPictureName As String
    
    sPictureName = "FormulasTop"
    
'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "CreateFormulasTop"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------
    
    On Error Resume Next
    Worksheets("Formulas").Shapes(sPictureName).Delete
    On Error GoTo ErrHandler
   
    sStepID = "copying Formulas worksheet top as picture"
   
'   Copy the range that will become the picture.
'   Paste the "temporary version" of picture.
    With Worksheets("Form Top")
        .Range("FormulasTop").Copy
        Set pPicTop = .Pictures.Paste
    End With
    
    sStepID = "formatting Formulas worksheet top picture"
       
'   Format the picture to be filled with white so it is opaque.
    With pPicTop.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With

    sStepID = "putting form picture into Formulas worksheet"

'   Cut the picture to prepare for the paste to the formulas worksheet.
    pPicTop.Cut
    
'   Copy the picture to the Formulas worksheet.
    With Worksheets("Formulas")
        .Activate
        
        .Range("A1").Activate
        
        Set pPicTop = .Pictures.Paste
        
        pPicTop.Name = sPictureName
        
        .Range("B19").Activate
        
    End With
    
'   Nudge the picture to the right.
    pPicTop.ShapeRange.IncrementLeft 3.3333070866

    Application.CutCopyMode = False

Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub



' ----------------------------------------------------------------
' Procedure Name: ImportReportWorksheet
' Purpose: Allow user to point to then open the new Report file.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 8/10/2023
' ----------------------------------------------------------------

Sub ImportReportWorksheet()

    Dim wsReportNew As Worksheet
    
    Dim sPathAndFile As String
    
    Dim sStartPath As String
    
    Dim rCell As Range
    
'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "ImportReportWorksheet"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------

 '  Error Messaging
    sStepID = "1. setting path to the Report"
                
    'sStartPath = "C:\Users\" & Environ("Username") & "\Desktop"
    sStartPath = ThisWorkbook.Path
    
    Application.DisplayAlerts = False
    
    sStepID = "2. deleting existing Report worksheet"
    
    On Error Resume Next
    ThisWorkbook.Worksheets("Report").Delete
    On Error GoTo ErrHandler
   
'   Error Messaging
    sStepID = "3. getting path and file for Report"
   
'   Let user point to the report file to open.
    Call GetFileName(sPathAndFile, sStartPath, "Report File", "*.xl*")

 '  Error Messaging
    sStepID = "4. opening and accessing Report workbook"

'   Get/open the report folder
    Workbooks.Open sPathAndFile

'   Point worksheet object at the Report worksheet in the workbook
'   opened just above and which becomes the active workbook.
    Set wsReportNew = ActiveWorkbook.Worksheets(1)

 '  Error Messaging
    sStepID = "5. checking that worksheet is a Report"

'   Check that it is a Report worksheet which was imported. Do so by
'   looking for the string "Report Parameters" in the raw report.
    With wsReportNew
        
        Set rCell = .Cells.Find(What:="Report Parameters", _
            After:=.Cells(1, 1), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=True)
    
        If rCell Is Nothing _
         Then
            MsgBox "The worksheet imported is not a Report", vbCritical
            
            ActiveWorkbook.Close
            
            Exit Sub
    
        End If
    
    End With

 '  Error Messaging
    sStepID = "6. importing Report worksheet"

'   Put the raw report into the
    wsReportNew.Move Before:=ThisWorkbook.Sheets(1)
    
 '  Error Messaging
    sStepID = "7. naming and formatting Report worksheet"
    
'   Rename the just imported raw version of the report.
    ActiveSheet.Name = "Report"
    
'   Do reformatting of the report.
    Call ReformatReport

Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub



' ----------------------------------------------------------------
' Procedure Name: ReformatReport
' Purpose: Reformat and remove merged cells from the stations groups ranges.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 7/20/2023
' ----------------------------------------------------------------

Sub ReformatReport()

'   Worksheet object for the worksheet named original
    Dim wsReport As Worksheet
    
    Dim wsLoop As Worksheet
    
    Dim bReportSheetExists As Boolean
    
    Dim sReportSheetName As String
    
'   Used when looping through data a station's data.
    Dim iRow As Long
    
'   Used when looping through stations.
    Dim iStation As Long

'   Used to get count of rows for each station.
    Dim avNumberRows() As Variant

'   Used to locate the last row in stations' data range.
    Dim iLastRow As Long
    
'   Used as a flag to tell code whether the workshet has already been reformatted.
    Dim vIsReportFormatted As Variant
    
    Dim sPageHeaderText As String

    Dim sRunLabel1 As String
    
    Dim sRunLabel2 As String
    
    Dim sRunLabel3 As String
    
'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "ReformatReport"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------

    Application.DisplayAlerts = False
            
'   --------------------------------------------
'        The Report Worksheet Must Exist
'   --------------------------------------------

'   Error Messaging
    sStepID = "1. checking Report worksheet exists"

    sReportSheetName = "Report"
    
    bReportSheetExists = False
    
    For Each wsLoop In ThisWorkbook.Worksheets
    
        If wsLoop.Name = sReportSheetName _
         Then
            bReportSheetExists = True
            Exit For
        End If
    
    Next wsLoop
    
    If Not bReportSheetExists _
     Then
        MsgBox "The worksheet named " & sReportSheetName & " was not found.", vbExclamation
        Exit Sub
    End If
    
'   --------------------------------------------
'                Initializations
'   --------------------------------------------
    
'   Error Messaging
    sStepID = "2. initializations"
    
'   Point worksheet object to the worksheet named Report.
    Set wsReport = ThisWorkbook.Worksheets(sReportSheetName)
    
'   Get/set the last row in the data.
    iLastRow = wsReport.Range("A1").Cells(Rows.Count, 1).End(xlUp).Row
        
    vIsReportFormatted = False
    
    On Error Resume Next
    vIsReportFormatted = wsReport.Names("HasBeenFormatted").Index <> (Err.Number = 0)
    On Error GoTo ErrHandler

'   Do not reformat the worksheet if it has already been processed.
    If vIsReportFormatted _
     Then
        MsgBox "The data has already been formatted.", vbInformation
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'   Error Messaging
    sStepID = "3. checking Report worksheet exists"
    
'   Turn off gridlines (visible).
    ActiveWindow.DisplayGridlines = False
          
    With wsReport
        sPageHeaderText = .Range("H1")
    
        sRunLabel1 = .Range("Z1")
    
        sRunLabel2 = .Range("Z2")
    
        sRunLabel3 = .Range("Z3")
    End With

'   -----------------------------------------------------
'          Remove Borders and cell Fill Color
'   -----------------------------------------------------
          
'   Error Messaging
    sStepID = "4. removing cell borders and fill color"
          
'   Remove cell borders at the top of the worksheet.
    With wsReport.Range("A1:AK20")
    
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
            
    End With
    
'   Remove blue at top of the Report worksheet.
    With wsReport.Rows("4:4").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
      
'   -----------------------------------------------------
'       Move column D values -- if any -- to Column C
'   -----------------------------------------------------

'   Some Recipe Names are located in column D. All should be in
'   column C so move those values in column D to column C.
    With wsReport.Range("D1")

        For iRow = 1 To iLastRow

            If .Cells(iRow) <> "" Then .Cells(iRow).Offset(0, -1).value = .Cells(iRow).value
            .Cells(iRow) = ""

        Next iRow

    End With

'   ----------------------------------------------
'       Remove Extra Columns, Align Remaining
'   ----------------------------------------------

'   Error Messaging
    sStepID = "5. removing extra columns, aligning remaining"

'   Delete the extra columns in data groups' range. That has the
'   effect of unmerging the cells for the respective data item.
'   Also, format the alignment of the remaining cells. Note,
'   statrt with leftmost columns and when processing delete columns
'   from right to left.

    With wsReport

        .Columns("AK:AK").Delete Shift:=xlToLeft
        .Columns("AJ:AJ").Delete Shift:=xlToLeft
        With .Columns("AI:AI")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("AH:AH").Delete Shift:=xlToLeft
        .Columns("AG:AG").Delete Shift:=xlToLeft
        With .Columns("AF:AF")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("AE:AE").Delete Shift:=xlToLeft
        .Columns("AD:AD").Delete Shift:=xlToLeft
        .Columns("AC:AC").Delete Shift:=xlToLeft
        With .Columns("AB:AB")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("AA:AA").Delete Shift:=xlToLeft
        .Columns("Z:Z").Delete Shift:=xlToLeft
        With .Columns("Y:Y")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("X:X").Delete Shift:=xlToLeft
        With .Columns("W:W")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("V:V").Delete Shift:=xlToLeft
        .Columns("U:U").Delete Shift:=xlToLeft
        With .Columns("T:T")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("S:S").Delete Shift:=xlToLeft
        With .Columns("R:R")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("Q:Q").Delete Shift:=xlToLeft
        .Columns("P:P").Delete Shift:=xlToLeft
        With .Columns("O:O")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("N:N").Delete Shift:=xlToLeft
        With .Columns("M:M")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("L:L").Delete Shift:=xlToLeft
        .Columns("K:K").Delete Shift:=xlToLeft
        With .Columns("J:J")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("I:I").Delete Shift:=xlToLeft
        .Columns("H:H").Delete Shift:=xlToLeft
        With .Columns("G:G")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("F:F").Delete Shift:=xlToLeft
        .Columns("E:E").Delete Shift:=xlToLeft
        .Columns("D:D").Delete Shift:=xlToLeft
        With .Columns("C:C")
            .Cells.HorizontalAlignment = xlCenter
            .Cells.VerticalAlignment = xlBottom
        End With

        .Columns("B:B").Delete Shift:=xlToLeft

    End With

'   ------------------------------
'       Various Columns' Width
'   ------------------------------

'   Error Messaging
    sStepID = "6. setting columns' width"

    With wsReport
        .Columns("A:A").EntireColumn.ColumnWidth = 8.5   'Recipe #

        .Columns("B:B").EntireColumn.ColumnWidth = 18   'Recipe name

        .Columns("C:C").EntireColumn.ColumnWidth = 10   'Portion Size

        .Columns("D:D").EntireColumn.ColumnWidth = 15.43 'Utensils

        .Columns("E:E").EntireColumn.ColumnWidth = 7.5  'HACCP

        .Columns("F:F").EntireColumn.ColumnWidth = 9.14  'Prep Svgs Total

        .Columns("G:G").EntireColumn.ColumnWidth = 7.9    'Leftover

        .Columns("H:H").EntireColumn.ColumnWidth = 8.71  'Serve Svgs Total

        .Columns("I:I").EntireColumn.ColumnWidth = 8.71  'Serve Svgs ALC

        .Columns("J:J").EntireColumn.ColumnWidth = 8.71  'Serve Svgs Reimb

        .Columns("K:K").EntireColumn.ColumnWidth = 8.57  'After Cook Temp

        .Columns("L:L").EntireColumn.ColumnWidth = 8.64  'Temp 1

        .Columns("M:M").EntireColumn.ColumnWidth = 8.64  'Temp 2
     End With

'   ----------------------------
'       Remove Rows' Merging
'   ----------------------------

'   Error Messaging
    sStepID = "7. removing rows' merging"

'   Some rows will have merged cells -- dates and location. Unmerge those cells.
    wsReport.Rows.AutoFit

    With wsReport.Range("A1")

        For iRow = 1 To iLastRow

            With .Cells(iRow)
                .MergeCells = False
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlBottom
                .WrapText = False
                
                If .value = "Recipe #" _
                 Then
                    .HorizontalAlignment = xlCenter
                    .RowHeight = 24
                End If
            End With
        
        Next iRow
                
    End With
    
'   ----------------------------
'       Cells Format xlTop
'   ----------------------------

'   Error Messaging
    sStepID = "8. setting cells' vertical alignment"

'   Format all data cells to have vertical alignment of top.
    With wsReport.Range("A1")
        For iRow = 1 To iLastRow
        
            If .Cells(iRow).value Like "##*" _
             Then
                .Cells(iRow).EntireRow.VerticalAlignment = xlTop
            End If
        
        Next iRow
    End With

'   ---------------------------------------
'          Format Page (i.e., "Layout")
'   ---------------------------------------

'   Error Messaging
    sStepID = "9. doing page layout"

'   Format the page so it is printable.
    With wsReport
        
'       Set page margins.
        With .PageSetup
            .Orientation = xlLandscape
            .Zoom = 90
        
            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.5)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
        
            .CenterHorizontally = True
            .CenterVertically = True
        
        End With
        
'       Set row height for rows between data groups.
        With .Range("A21")
        
            For iRow = 1 To iLastRow
                If Trim(.Cells(iRow).value) = "" _
                 Then .Cells(iRow).RowHeight = 3
            Next
            
            .Cells(iLastRow + 1).RowHeight = 3
            
        End With
        
'       Format borders for the leftmost column in the data groups.
        .Columns("L:L").Copy
        
        .Columns("M:M").PasteSpecial Paste:=xlPasteFormats
        
        With .Columns("N:N")
            .PasteSpecial Paste:=xlPasteFormats
            
            With .Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            
            .ColumnWidth = 0.33
            
        End With
            
'   -----------------------------------------------
'           Manage Range at Bottom of Page
'   -----------------------------------------------

'   Error Messaging
    sStepID = "10. formatting page bottom"

        With .Range("A109:M109")
            .RowHeight = 25
            .MergeCells = True
            .WrapText = True
            .VerticalAlignment = xlTop
        End With
        
        With .Range("A114:M114")
            .RowHeight = 25
            .MergeCells = True
            .WrapText = True
            .VerticalAlignment = xlTop
        End With
                
    End With 'wsReport

'   -----------------------------------------------
'           Manage Range at Top of Page
'   -----------------------------------------------

'   Error Messaging
    sStepID = "11. formatting page top"

    With wsReport
        .Activate
        
        .Range("A4:A19").EntireRow.Delete Shift:=xlUp
        
        .Range("B3").Activate
        
        .Range("C1").value = sPageHeaderText
        
        With .Range("C1:K1")
            .HorizontalAlignment = xlCenterAcrossSelection
            .VerticalAlignment = xlTop
            .WrapText = False
            .MergeCells = False
            
            With .Font
                .Name = "sans-serif"
                .Size = 12
                .Bold = True
            End With
        End With
    
        .Range("M2").value = sRunLabel1
        .Range("M3").value = sRunLabel2
        .Range("M4").value = sRunLabel3
        
        With .Range("M2:M4")
            .HorizontalAlignment = xlRight
            .WrapText = False
        End With
        
    End With 'wsReport
    
    Application.CutCopyMode = False
    
'   -----------------------------------------------
'         Add numbers to Station's Menu Items
'   -----------------------------------------------
    
'   Error Messaging
    sStepID = "12. adding line item numbers"

    Call GetReportStationsData(avNumberRows())
    
    With wsReport
        
'       Insert column A for row numbers.
        .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
'       Column A width
        .Columns("A:A").ColumnWidth = 2.43
                
'       Get row counts. Put them into the station's menu items' rows.
        For iStation = 1 To UBound(avNumberRows, 2)
            
            With .Range("A1").Cells(avNumberRows(1, iStation))
            
                For iRow = 1 To avNumberRows(2, iStation)
                    .Offset(iRow - 1) = iRow
                    
                    .VerticalAlignment = xlTop
                Next iRow

            End With
        
        Next iStation
        
    End With 'Worksheets("Report")
    
'   -------------------------------------------------------
'         Remove remaining merged cells in Report data
'   -------------------------------------------------------
    
    sStepID = "13. removing remaining merged cells"
    
    With wsReport.Range("B1")

        For iRow = 1 To iLastRow
    
            With .Cells(iRow)
                .MergeCells = False
                .WrapText = False
            End With
        
        Next iRow
            
    End With

'   ---------------------------------------------------
'         Add Report worksheet scoped Name as Flag
'   ---------------------------------------------------
    
'   So code knows whether a report worksheet has already been
'   reformatted add a name to the worksheet as a flag.
    
    sStepID = "14. adding has been processed name"
    wsReport.Names.Add Name:="HasBeenFormatted", RefersTo:="=TRUE"
    
'   Error Messaging
    sStepID = "15. closing out"
    
    Worksheets("Formulas").Activate
    
    Application.EnableEvents = True
    
Closeout:
    
Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub



' ----------------------------------------------------------------
' Procedure Name: StationDataToFormulasSheet
' Purpose: Copy station/menu data from Report worksheet to Formulas worksheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 8/8/2023
' ----------------------------------------------------------------
Sub StationDataToFormulasSheet()

'   Array holding data about stations in the Report.
    Dim avReportRanges() As Variant
    
'   Array holding data about anchor cells in the Formulas.
    Dim avFormulasAnchorsRows() As Variant
    
'   The worksheet named Formulas.
    Dim wsFormulas As Worksheet
    
'   The worksheet named Report.
    Dim wsReport As Worksheet
    
'   Used for iterating through stations in Report worksheet.
    Dim iStation As Long
    
'   Count of stations in the Report worksheet.
    Dim iReportStationsCount As Long
    
'   Count of stations in the Report worksheet.
    Dim iFormulasStationsCount As Long
    
'   Rows count for the station being processed.
    Dim iStationRowsCount As Long
    
'   Holds the name of the station being processed.
    Dim sStationName As String
    
'   Count of (unused) rows to hide for a station in the Formulas worksheet.
    Dim iHideRowsCount As Long
    
'   Range where the station-specific anchor cell is located in Formulas worksheet.
    Dim rFormulasStationAnchor As Range
    
'   Range where the station-specific anchor cell is located in Report worksheet.
    Dim rReportStationAnchor As Range
    
'   Count of data columns to transfer from Report to Formulas for each station.
    Dim iDataColumnsCount As Long
    
'   Count of ALL rows of data in all stations in Formulas worksheet.
'   ALL meaning includes hidden rows, if any.
    Dim iAllStationRowsCount As Long
    
    
'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    
    sSubName = "StationDataToFormulasSheet"
    sStepID = ""
    On Error GoTo ErrHandler
'   ----------------------

'   How many columns of data to copy from Report to Formulas worksheet.
    iDataColumnsCount = 5
    
'   Set count of ALL rows of data in all stations in Formulas worksheet.
    iAllStationRowsCount = 20

'   Error Messaging
    sStepID = "setting worksheet Report and Formulas objects"
    
    Set wsFormulas = [Formulas]

    Set wsReport = Worksheets("Report")
    
'   Error Messaging
    sStepID = "1. getting Report and Formulas worksheet rows' data"
        
'   Fill array that contains the row numbers of and rows count for stations'
'   data in the Report worksheet. The second parameter is the column offset
'   (from a row's index column).
    Call GetReportStationsData(avReportRanges(), 1)
    
'   Fill array that contains the anchor cell's row numbers of and rows count
'   for stations' data in Formulas worksheet
    Call GetFormulasRowsData(avFormulasAnchorsRows())

'   Get count of stations in 1. the Report worksheet, 2. the Formulas worksheet.
    iReportStationsCount = UBound(avReportRanges, 2)
    
    iFormulasStationsCount = UBound(avFormulasAnchorsRows, 2)

'   Error Messaging
    sStepID = "2. processing Formulas worksheet data"
        
    For iStation = 1 To iReportStationsCount
    
        With wsFormulas
        
'           Unhide the station data rows in Formulas worksheet for the station being processed.
            .Range("Station" & iStation & "Rows").EntireRow.Hidden = False
              
'           Set/get anchor cell in formulas worksheet for the respective station.
            Set rFormulasStationAnchor = .Range("B1").Offset(avFormulasAnchorsRows(1, iStation))
            
'           Put the station name two cells above the station anchor cell
'           (i.e., range rFormulasStationAnchor).
            rFormulasStationAnchor.Offset(-2).value = avReportRanges(3, iStation)
            
'           Hide all rows for the station in formulas worksheet.
            With rFormulasStationAnchor
            
'               Hide all rows for a station in Formulas worksheet.
                .Resize(avFormulasAnchorsRows(2, iStation)).EntireRow.Hidden = True
                
'               Clear all values for the respective statio in the formulas worksheet.
                .Resize(avFormulasAnchorsRows(2, iStation), iDataColumnsCount).value = ""
                
            End With
            
'           Unhide rows needed in formulas worksheet for the respective station
'           in the report worksheet.
            With rFormulasStationAnchor
                .Resize(avReportRanges(2, iStation)).EntireRow.Hidden = False
                .Resize(avReportRanges(2, iStation)).EntireRow.AutoFit
            End With
        
        End With

'   Error Messaging
    sStepID = "3. processing Report worksheet data"
        
        With wsReport
        
'           DATA anchor cell for the station being copied from in Report worksheet.
            Set rReportStationAnchor = .Range("B1").Cells(avReportRanges(1, iStation))
            
'           Copy data from Report worksheet and paste to Formulas worksheet.
            With rReportStationAnchor.Resize(avReportRanges(2, iStation), iDataColumnsCount)
                .Copy rFormulasStationAnchor
            End With
                        
            rReportStationAnchor.Resize(avReportRanges(2, iStation)).EntireRow.AutoFit
            
        End With

    Next iStation

'   Error Messaging
    sStepID = "4. hiding unused Formulas station(s)"
    
'   Hide any unused stations in the Formulas worksheet.
    If iReportStationsCount < iFormulasStationsCount _
     Then
        For iStation = iReportStationsCount + 1 To iFormulasStationsCount
        
            [Formulas].Range("Station" & iStation & "Rows").EntireRow.Hidden = True
        
        Next iStation
    
    End If
    
'   Error Messaging
    sStepID = "5. formatting formula's cells' inner/vertical and right borders"
    
    With wsFormulas
    
        For iStation = 1 To iReportStationsCount
        
'           Set/get anchor cell in formulas worksheet for the respective station.
            Set rFormulasStationAnchor = .Range("B1").Offset(avFormulasAnchorsRows(1, iStation))

            With rFormulasStationAnchor.Resize(iAllStationRowsCount, iDataColumnsCount)

                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ThemeColor = 1
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 1
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
            
            End With
            
        Next iStation
    
    End With 'wsFormulas
    
    Application.Calculate

Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID)

End Sub