VBA automatically update part of range variables based on last column

[tjdickinson]

My code contains a number of range variables such as the following, which I need to update automatically based on the number of columns (where T is the last column with data, and U repeats the references in colA).

Dim fmtRng As Range: Set fmtRng = Range("B3:T15, B20:T32, B37:T49, B54:T66, B71:T83")
Dim dayHeader As Range: Set dayHeader = Range("A1:U1, A18:U18, A35:U35, A52:U52, A69:U69")

The thing is, I don't know how to code changing only part of the range. The first values (colA or colB) don't need to change, nor do the rows ever need to change. Only the column reference (in this case, T and U).

What I think might be helpful is that I declare an array variable including the headers of the data columns:

Dim lkInits() As Variant: lkInits = VBA.Array("", "BTH", "BHU", "DDU", "DHE", "DKE", "EGO", "FLE", "GAR", "HOV", "IPI", "LST", "MHLE", "MSU", "GVE", "SWU", "RRE", "SME", "TDI", "XFI")

I will always need to manually update this array whenever the data changes, so the count of items in the array could serve as a reference to identify the last column(s). The index of the last item (here, "XFI") corresponds to the last data column (T in the example above), and the index value + 1 would refer to the repeated reference column (U in the example above). But again, I'm just not sure how to get this information and use it to define part of a range area.

Additionally, further on in the code, I have the following, where the r.Offset(, 20) value needs to be updated to point to the last column (U in the example above, coming from column A).

For Each r In timeCol.Areas
    r.Value = timeFill
    r.Offset(, 20).Value = timeFill
Next

Thanks in advance to anyone who can give some tips or suggestions!

 

[BSALV]

i added the timefill from yesterday

Sub TJ()
     Dim dayHeader As Range: Set dayHeader = Range("A1, A18, A35, A52, A69")
     Dim lkInits() As Variant: lkInits = Array("", "BTH", "BHU", "DDU", "DHE", "DKE", "EGO", "FLE", "GAR", "HOV", "IPI", "LST", "MHLE", "MSU", "GVE", "SWU", "RRE", "SME", "TDI", "XFI")
     Dim timeFill As Variant: timeFill = Application.Transpose(Array("", "8:00", "8:20", "9:10", "10:00", "10:20", "11:10", "12:00", "12:30", "13:00", "13:50", "14:40", "15:00", "15:50"))
     r = UBound(timeFill)

     For Each c In dayHeader.Cells
          c.Resize(, UBound(lkInits) + 1).Value = lkInits       'headerrow
          c.Offset(2, 1).Resize(r, UBound(lkInits)).Value = timeFill     '"x"     'timefill
          c.Offset(2, 1 + UBound(lkInits)).Resize(r, 1).Value = c.Offset(2).Resize(r).Value     'repeat column A
     Next

End Sub

 

[tjdickinson]

Sub TJ()
     Dim dayHeader As Range: Set dayHeader = Range("A1, A18, A35, A52, A69")
     Dim lkInits() As Variant: lkInits = Array("", "BTH", "BHU", "DDU", "DHE", "DKE", "EGO", "FLE", "GAR", "HOV", "IPI", "LST", "MHLE", "MSU", "GVE", "SWU", "RRE", "SME", "TDI", "XFI")
     Dim timeFill As Variant: timeFill = Application.Transpose(Array("", "8:00", "8:20", "9:10", "10:00", "10:20", "11:10", "12:00", "12:30", "13:00", "13:50", "14:40", "15:00", "15:50"))
     r = UBound(timeFill)

     For Each c In dayHeader.Cells
          c.Resize(, UBound(lkInits) + 1).Value = lkInits       'headerrow
          c.Offset(2, 1).Resize(r, UBound(lkInits)).Value = timeFill     '"x"     'timefill
          c.Offset(2, 1 + UBound(lkInits)).Resize(r, 1).Value = c.Offset(2).Resize(r).Value     'repeat column A
     Next

End Sub

Thanks for the response, @BSALV ! First, just as an observation, I think it ought to be r = UBound(lkInits), right?

The only possible issue I see otherwise is that I have 10 different ranges (each with multiple range areas) that need to be updated based on r, and each range does different things, including some cell merging. (So, for example, later on in the code, I have dayHeader.MergeCells = True, which wouldn't work if the range variable doesn't include the upper bound in it.) The range variables are also called multiple times in the code, so I think it would be less efficient to have to redefine the range upper bound each time.

What I see, though, is that we can use the r value as a reference point in defining the ranges. Is there a way to put that directly into the range declarations? For example (and I know this code won't work, but it's just an illustration):

Dim fmtRng As Range: Set fmtRng = Range("B3:Cells(15, r), B20:Cells(32, r), B37:Cells(49, r), ...")
Dim dayHeader As Range: Set dayHeader = Range("A1:Cells(1, r + 1), A18:Cells(18, r + 1), ...")

(And maybe, to optimise it even a bit more, a variable s = r + 1 could be defined at the top?)

How would I do something like this (if it's even possible)?

 

[footoo]

Assuming the headings are in row 1 (and in your example the last column with a header is column U) :

Sub v()
Dim lc&, r&, fmtRng As Range, dayHeader As Range
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set fmtRng = [B3].Resize(13, lc - 2)
Set dayHeader = [A1].Resize(, lc)
For r = 20 To 71 Step 17
    Set fmtRng = Union(fmtRng, Cells(r, 2).Resize(13, lc - 2))
    Set dayHeader = Union(dayHeader, Cells(r - 2, 1).Resize(, lc))
Next
MsgBox fmtRng.Address(0, 0)
MsgBox dayHeader.Address(0, 0)
End Sub

 

[BSALV]

i hate merged cells, so, i can't help you.
They 're always causing problems.

 

[tjdickinson]

Assuming the headings are in row 1 (and in your example the last column with a header is column U) :

Sub v()
Dim lc&, r&, fmtRng As Range, dayHeader As Range
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set fmtRng = [B3].Resize(13, lc - 2)
Set dayHeader = [A1].Resize(, lc)
For r = 20 To 71 Step 17
    Set fmtRng = Union(fmtRng, Cells(r, 2).Resize(13, lc - 2))
    Set dayHeader = Union(dayHeader, Cells(r - 2, 1).Resize(, lc))
Next
MsgBox fmtRng.Address(0, 0)
MsgBox dayHeader.Address(0, 0)
End Sub

Thanks for the reply, @footoo and @BSALV ! The headers are in the code and will be put into rows 2, 19, 36, 53, and 70.

BSALV, the merged cells are only an example, of course. There's a lot else going on with the code using the ranges in various ways, but indeed, my primary purpose is formatting and layout.

The whole thing is a bit of a messy project--I'm working with timetable files exported from a generating software to PDF and converted by Acrobat to Excel. What we're looking at here is the formatting of the "big picture" timetable with all the classes and all the teachers. Each block of data represents one day (thus why the headers and things are repeating, and why there are so many multi-area ranges).

And on top of it, I'm still rather green when it comes to VBA. I've only been working with it for half a year or so.

If it helps to see the full code to have a better picture of what's going on, I'll paste it below.

Thanks for your help!

Sub fullTT()

'***CAUTION: This macro still has an issue with formatting different footers on odd/even pages.

' This macro sets the formatting on the full timetable (one sheet containing all timetables). _
  Before running, ensure all information is correct.
  
' Set variables. Copy and paste as needed from Module 1.
' Set class names
Dim classNamesA(1 To 20) As String
Dim classNamesB(1 To 20) As String

classNamesA(1) = "4 HUM 4 LAT"
classNamesB(1) = "4 ASO"
classNamesA(2) = "5 HUM 5 LAT-MT 6 LAT-MT"
classNamesB(2) = "3de Graad"
classNamesA(3) = "3 HUM 3 LAT"
classNamesB(3) = "3 ASO"
classNamesA(4) = "6 LAT-MT"
classNamesB(4) = "6 ASO"
classNamesA(5) = "5 HUM 5 LAT-MT"
classNamesB(5) = "5 ASO"
classNamesA(6) = "2A KT 2A MT-W"
classNamesB(6) = "2A"
classNamesA(7) = "1A1 1A2 2A MT-W 2A KT"
classNamesB(7) = "1ste Graad"
classNamesA(8) = "1A1 1A2 2A KT 2A MT-W"        ' **This string typically refers to the combined 1st grade, but it also appears as a truncation for all years combined for MIS (13)
classNamesB(8) = "1ste Graad"
classNamesA(9) = "3 HUM 3 LAT 4 HUM 4 LA"       ' **This string appears in some LO/BEZ truncations referring to the combined 2nd/3rd grade; it is identical to (11)
classNamesB(9) = "2de/3de Graad"
classNamesA(10) = "3 HUM 6 LAT-MT 4 LAT 5 L"    ' This unique string appears in some LO truncations for the combined 2nd/3rd grade
classNamesB(10) = "2de/3de Graad"
classNamesA(11) = "3 HUM 3 LAT 4 HUM 4 LA"      ' **This string is identical to (9), but for GODS refers only to the 2nd grade
classNamesB(11) = "2de Graad"
classNamesA(12) = "1A1 1A2"
classNamesB(12) = "1A"
classNamesA(13) = "1A1 1A2 2A KT 2A MT-W"       ' **This string is identical to (8), but here as a truncation for all the years at MIS. However, the MIS cell will be overwritten in the next sub.
classNamesB(13) = ""
classNamesA(14) = "5 LAT-MT"
classNamesB(14) = "5 LAT"
classNamesA(15) = "1A1 6 LAT-MT 4 LAT 3 HU"     ' This unique string appears in some truncations for MIS. The cell will be overwritten in the next sub.
classNamesB(15) = ""
classNamesA(16) = "5 LAT-MT 6 LAT-MT"
classNamesB(16) = "5/6 LAT"

' Set fonts
Dim nameHeaderFont As String: nameHeaderFont = "Alegreya Sans ExtraBold"
Dim nameHeaderSize As Integer: nameHeaderSize = 12
Dim dayTimeFont As String: dayTimeFont = "Alegreya Sans Medium"
Dim dayTimeSize As Integer: dayTimeSize = 9
Dim tableFont As String: tableFont = "Alegreya Medium"
Dim tableFontSize As Integer: tableFontSize = 9
Dim misFont As String: misFont = "Alegreya SC ExtraBold"
Dim misFontSize As Integer: misFontSize = 10
Dim lunchFont As String: lunchFont = "Alegreya Sans SC ExtraBold"
Dim lunchFontSize As Integer: lunchFontSize = 10
Dim breakFont As String: breakFont = "Alegreya Sans SC ExtraBold"
Dim breakFontSize As Integer: breakFontSize = 10
    ' NB: page header/footer fonts must be set in code, not with variables

' Set column and row sizes
Dim nameHeaderHeight As Integer: nameHeaderHeight = 25
Dim dayRowHeight As Integer: dayRowHeight = 13
Dim lessonBlockHeight As Integer: lessonBlockHeight = 29
Dim breakRowHeight As Integer: breakRowHeight = 13
Dim timeColWidth As Integer: timeColWidth = 4.5
Dim dayColWidth As Integer: dayColWidth = 9.5
Dim spacerRowHeight As Integer: spacerRowHeight = 15

' Set fill tints
Dim bkgrOrng As Double: bkgrOrng = 0.799981688894314    ' the background of the whole schedule area (LK) and supervision assignment cells (TZ)
Dim subheadOrng As Double: subheadOrng = 0.599993896298105   ' the days row, lunch row, times column, and MIS cell
Dim brkRowTint As Double: brkRowTint = -0.249946592608417   ' the break rows

' Logo location
Dim LogoFile As String: LogoFile = "G:\Shared drives\Sint-Ignatius ICT Admin\Style Guide\Logos\PNG\SI Logo@0.5x.png"

' Theme Location
Dim ThemeFile As String: ThemeFile = "G:\Shared drives\Sint-Ignatius ICT Admin\Style Guide\Templates\Themes\Document Theme\Sint-Ignatius.thmx"

' Set array of teachers
Dim lkInits() As Variant: lkInits = VBA.Array("", "BTH", "BHU", "DDU", "DHE", "DKE", "EGO", "FLE", "GAR", "HOV", "IPI", "LST", "MHLE", "MSU", "GVE", "SWU", "RRE", "SME", "TDI", "XFI")

' Set ranges
Dim fmtRng As Range: Set fmtRng = Range("B3:T15, B20:T32, B37:T49, B54:T66, B71:T83")    ' the "schedule area"
Dim dayHeader As Range: Set dayHeader = Range("A1:U1, A18:U18, A35:U35, A52:U52, A69:U69")   ' the cells containing the days of the week
Dim breakRow As Range: Set breakRow = Range("B6:T6, B10:T10, B13:T13, B20:T20, B23:T23, B27:T27, B30:T30, B37:T37, B40:T40, B44:T44, B47:T47, B54:T54, B57:T57, B61:T61, B64:T64, B71:T71, B74:T74")   ' the break rows
Dim lkNames As Range: Set lkNames = Range("A2:T2, A19:T19, A36:T36, A53:T53, A70:T70")   ' the rows containing teacher names
Dim lunchRow As Range: Set lunchRow = Range("B9:T9, B26:T26, B43:T43, B60:T60")   ' the rows containing lunch
Dim misCell As Range: Set misCell = Range("B32:T32")   ' the Mass cell
Dim timeCol As Range: Set timeCol = Range("A2:A15, A19:A32, A36:A49, A53:A66, A70:A83")
'Dim timeCol As Range: Set timeCol = Range("A2:A15, A19:A32, A36:A49, A53:A66, A70:A83, U2:U15, U19:U32, U36:U49, U53:U66, U70:U83")
Dim spacerRow As Range: Set spacerRow = Range("A17:U17, A34:U34, A51:U51, A68:U68")   ' the blank row between each day's table
Dim deleteRows As Range: Set deleteRows = Range("3:5, 16:16, 33:33, 50:50, 67:67, 77:87")

' Set array of times
Dim timeFill() As Variant: timeFill = Application.Transpose(Array("", "8:00", "8:20", "9:10", "10:00", "10:20", "11:10", "12:00", "12:30", "13:00", "13:50", "14:40", "15:00", "15:50"))

Application.DisplayAlerts = False

ActiveWorkbook.ApplyTheme (ThemeFile)
ActiveSheet.Name = "ALG"

' Unmerge rows
For Each c In fmtRng    ' check each cell in the timetable
    If c.MergeArea.Columns.Count > 1 Then    ' if the cell is merged in rows (vs. merged in columns, as in a lesson in consecutive hours)
        If c.MergeArea.Cells(1) = "" Or c.MergeArea.Cells(1) = "pauze" Then    ' if the cell is empty or containse "pauze"; NB: may be case sensitive
            c.MergeArea.UnMerge    ' unmerge the row
        End If
    End If
Next

' Fill Times
Dim r As Range
For Each r In timeCol.Areas
    r.Value = timeFill
    r.Offset(, 20).Value = timeFill
Next

' Add table data
lunchRow.Value = "Lunch"
lunchRow.MergeCells = True
misCell.Value = "MIS"
misCell.MergeCells = True
lkNames.Value = lkInits
Range("A1").Value = "maandag"
Range("A18").Value = "dinsdag"
Range("A35").Value = "woensdag"
Range("A52").Value = "donderdag"
Range("A69").Value = "vrijdag"
dayHeader.MergeCells = True

' Rename classes
Dim StartPosition As Integer
Dim CompareResult As Integer
Dim CourseName As String

For Each cell In fmtRng    ' check only the schedule area of the sheet
     cell.Value = Application.WorksheetFunction.Trim(cell.Value)    ' remove any extra spaces that may have been added by GHC
     If cell.Value = "TOEZ. pauze" Then
        cell.Value = "TOEZ"
     ElseIf Len(cell) > 5 Then    ' exclude any cell which already contains "MIS", "Lunch", or "pauze"
          For i = 1 To UBound(classNamesA)    ' check each cell against each item in array A
               sp = Split(cell.Value, Chr(10))    ' split each cell value at the line break; sp(0) holds the course name and sp(1) holds the class name
               If UBound(sp) = 1 Then    ' checks if the variable has two parts
                    If sp(1) = classNamesA(i) Then    ' checks if the class name is in array A
                         CourseName = sp(0)    ' saves the course name in a variable
                         Select Case CourseName    ' conditions the result based on the course name
                              Case "MIS": cell.Value = CourseName    ' replaces MIS cell with only "MIS" (no class names)
                              Case "GODS": cell.Value = CourseName & Chr(10) & IIf(i = 9, classNamesB(11), classNamesB(i))    ' resolves the issue of identical truncations in (9) and (11)
                              Case Else: cell.Value = CourseName & Chr(10) & classNamesB(i)    ' set the value of all other cells to the course name and class name (from array B), separated by a line break
                         End Select
                    End If
               End If
          Next i
     End If
Next

' Format and fill remedial language courses
For Each cell In Range("L3:L85")
    If cell.Value = "" Then
        cell.Interior.ThemeColor = xlThemeColorAccent4
        cell.Interior.TintAndShade = subheadOrng
    End If
Next

Range("L8").Value = "(1A2 FRA /" & vbCrLf & "5 ASO NED)"
Range("L11").Value = "(1A1 FRA)"
Range("L12").Value = "(1A2 NED)"
Range("L14").Value = "(4 ASO NED)"
Range("L15").Value = "(1A1 NED /" & vbCrLf & "4 ASO NED)"
Range("L24").Value = "(1A2 NED)"
Range("L29").Value = "(1A1 NED)"
Range("L31").Value = "(4 ASO NED)"
Range("L39").Value = "(1A1 FRA /" & vbCrLf & "4 ASO NED)"
Range("L41").Value = "(1A2 FRA)"
Range("L42").Value = "(1A1 NED /" & vbCrLf & "1A2 FRA)"
Range("L45").Value = "(4 ASO FRA /" & vbCrLf & "5 ASO NED)"
Range("L46").Value = "(4 ASO FRA /" & vbCrLf & "5 ASO NED)"
Range("L48").Value = "(1A2 NED)"
Range("L49").Value = "(1A2 NED)"
Range("L55").Value = "(1A2 FRA)"
Range("L56").Value = "(4 ASO NED)"
Range("L58").Value = "(1A1 NED /" & vbCrLf & "4 ASO FRA)"
Range("L59").Value = "(4 ASO FRA)"
Range("L72").Value = "(1A1 FRA)"
Range("L73").Value = "(1A1 FRA /" & vbCrLf & "1A2 NED)"
Range("L75").Value = "(5 ASO NED)"
Range("L76").Value = "(1A1 NED /" & vbCrLf & "5 ASO NED)"

' Format the table
' Format names rows
With lkNames
    .Interior.ThemeColor = xlThemeColorDark2
    .Interior.TintAndShade = subheadOrng
    .Font.Name = dayTimeFont
    .Font.Size = dayTimeSize
    .Font.ThemeColor = xlThemeColorLight2
    .ColumnWidth = dayColWidth
    .RowHeight = dayRowHeight
End With

' Format Time column
Set timeCol = Range("A2:A85, U2:U85")
With timeCol
    .Interior.ThemeColor = xlThemeColorDark2
    .Interior.TintAndShade = subheadOrng
    .Font.Name = dayTimeFont
    .Font.Size = dayTimeSize
    .Font.ThemeColor = xlThemeColorLight2
    .ColumnWidth = timeColWidth
End With

' Format day heading
With dayHeader
    .Interior.ThemeColor = xlThemeColorDark2
    .Font.Name = nameHeaderFont
    .Font.Size = nameHeaderSize
    .Font.ThemeColor = xlThemeColorLight2
    .RowHeight = nameHeaderHeight
End With

' Format Schedule area
With fmtRng
    .Font.Name = tableFont
    .Font.Size = tableFontSize
    .Font.ThemeColor = xlThemeColorLight1
    .RowHeight = lessonBlockHeight
End With
        
' Format MIS cell
With misCell
    .Interior.ThemeColor = xlThemeColorDark2
    .Interior.TintAndShade = subheadOrng
    .Font.Name = misFont
    .Font.Size = misFontSize
    .Font.ThemeColor = xlThemeColorLight2
    .RowHeight = breakRowHeight
End With
    
' Format Lunch cell
With lunchRow
    .Interior.ThemeColor = xlThemeColorDark2
    .Interior.TintAndShade = subheadOrng
    .Font.Name = lunchFont
    .Font.Size = lunchFontSize
    .Font.ThemeColor = xlThemeColorLight2
    .RowHeight = breakRowHeight
End With
    
' Format Background
fmtRng.FormatConditions.Add Type:=xlExpression, Formula1:="=isblank(b3)=true"
fmtRng.FormatConditions(fmtRng.FormatConditions.Count).SetFirstPriority
With fmtRng.FormatConditions(1)
    .Interior.ThemeColor = xlThemeColorDark2
    .Interior.TintAndShade = bkgrOrng
    .StopIfTrue = False
End With
    
' Format Break rows
With breakRow
    .RowHeight = breakRowHeight
    .FormatConditions.Add Type:=xlExpression, Formula1:="=isblank(b6)=true"
    breakRow.FormatConditions(breakRow.FormatConditions.Count).SetFirstPriority
    With breakRow.FormatConditions(1)
        .Interior.ThemeColor = xlThemeColorDark1
        .Interior.TintAndShade = brkRowTint
        .StopIfTrue = False
    End With
End With

' Format spacer rows
With spacerRow
    .Interior.ColorIndex = 0
    .RowHeight = spacerRowHeight
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
End With
            
' Delete rows
deleteRows.Delete shift:=xlUp

' Format borders
Set fmtRng = Range("A1:U12, A14:U28, A30:U44, A46:U60, A62:U69")
With fmtRng
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
    .Borders(xlInsideHorizontal).ThemeColor = 4
    .Borders(xlInsideVertical).ThemeColor = 4
    .Borders(xlEdgeLeft).ThemeColor = 4
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeRight).ThemeColor = 4
    .Borders(xlEdgeRight).Weight = xlMedium
    .Borders(xlEdgeTop).ThemeColor = 4
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlEdgeBottom).ThemeColor = 4
    .Borders(xlEdgeBottom).Weight = xlMedium
End With

Dim wbPath As String
Dim fileName As String
Dim deleteMiddle As String
Dim fileArray() As String
Dim fileYear As String
Dim fileMonth As String
Dim fileVersion As String
Dim fileMonthNumber As Integer
Dim fileMonthFormat As String
Dim lFooter As String
Dim shTitle As String

wbPath = ActiveWorkbook.Path
fileName = Mid(Replace(ActiveWorkbook.FullName, wbPath, ""), 2)    ' get only the file name, excluding the path

' This block of code will only work if the file name has been constructed properly. _
  First, it begins to isolate the descriptive text, if it exists, but in so doing it also extracts the engine number.
deleteMiddle = Replace(Replace(fileName, " ", "", InStr(InStr(InStr(1, fileName, " ") + 1, fileName, " ") + 1, fileName, " "), 1), Mid(fileName, InStr(1, fileName, ".")), "")

For i = 1 To Len(deleteMiddle)    ' the loop will run no longer than the length of deleteMiddle
    If deleteMiddle Like "*R#*" Then    ' it checks if the string ends with R and one or more digits
        deleteMiddle = Left(deleteMiddle, Len(deleteMiddle) - 1)    ' and then it shortens it by one character
    ElseIf deleteMiddle Like "*R" Then    ' if the number is already deleted...
        deleteMiddle = Left(deleteMiddle, Len(deleteMiddle) - 1)    ' ...then the R is deleted as well
    End If
Next

' The first iteration of the new file name is composited by removing the descriptive text from the middle of the file name _
  and then removing the file extension (.xlsx) and the suffix (ex. _Leerkrachten).
fileName = Replace(Replace(fileName, " " & deleteMiddle, "."), Mid(fileName, InStr(1, fileName, "_"), Len(Mid(fileName, InStr(1, fileName, "_"), InStr(1, fileName, ".xlsx")))), "")

' Convert the new file name into the footer version identifier
fileArray = Split(fileName, " ", 4)    ' split the file name at the spaces
fileYear = fileArray(0)    ' extract the year (YY-YY) from the file name
fileMonth = fileArray(1)    ' extract the month (as a word) from the file name
fileVersion = Mid(fileArray(2), 2)   ' extract the version string from the file name
fileMonthNumber = Month(DateValue("1 " & fileMonth & " 2022"))    ' convert the month into a number

If fileMonthNumber > 8 Then    ' use the month number to determine which year the schedule will start in, and convert the year to a 4 digit number
    fileYear = "20" & Left(fileYear, 2)
Else: fileYear = "20" & Right(fileYear, 2)
End If

fileMonthFormat = Format(fileMonthNumber, "00")

lFooter = "v." & fileYear & "/" & fileMonthFormat & "." & fileVersion & "-"    ' construct the footer text

shTitle = "Algemeen Uurrooster"

' Add a page break
ActiveSheet.HPageBreaks.Add before:=Cells(35, 1)

' Apply the page formatting
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .LeftMargin = Application.CentimetersToPoints(1.25)
    .RightMargin = Application.CentimetersToPoints(1.25)
    .TopMargin = Application.CentimetersToPoints(1.25)
    .BottomMargin = Application.CentimetersToPoints(1.25)
    .HeaderMargin = Application.CentimetersToPoints(0.5)
    .FooterMargin = Application.CentimetersToPoints(0.5)
    .CenterVertically = True    ' centre the sheet vertically on the page
    .CenterHorizontally = True    ' centre the sheet horizontally on the page
    .CenterHeader = "&""Alegreya""&9&K000000" & "Fold and attach here"
    .LeftFooter = "&""Alegreya""&9&K000000" & lFooter & "&A"    ' set the font, font size, font colour, and footer text with the sheet name
'    .OddAndEvenPagesHeaderFooter = True
'    .DifferentFirstPageHeaderFooter = True
    .LeftHeaderPicture.fileName = LogoFile
    .LeftHeaderPicture.Height = 55.5
    .LeftHeader = "&G"    ' inserts a picture (= LogoFile)
    .CenterHeader = "&""Alegreya Sans SC ExtraBold""&18&K354896" & shTitle    ' set the font, font size, and font colour with the sheet title
    .CenterFooter = "&""Alegreya""&9&K000000" & "Fold and attach here"
End With

'ActiveSheet.PageSetup.OddAndEvenPagesHeaderFooter = True
'With ActiveSheet.PageSetup.OddAndEvenPagesHeaderFooter.EvenPage
'    .CenterHeader = "&""Alegreya""&9&K000000" & "Fold and attach here"
'    .LeftFooter = "&""Alegreya""&9&K000000" & lFooter & "&A"    ' set the font, font size, font colour, and footer text with the sheet name
'End With

' Save as
fileName = wbPath & "\" & fileArray(0) & " " & fileArray(1) & " v." & fileVersion & "_ALG.xlsx"
ActiveWorkbook.SaveAs fileName

Application.DisplayAlerts = True

End Sub

 

[footoo]

Assuming the last used column has a header in row 2 (at present U2), then :

Sub v()
Dim lc&, r&, fmtRng As Range, dayHeader As Range
lc = Cells(2, Columns.Count).End(xlToLeft).Column
Set fmtRng = [B3].Resize(13, lc - 2)
Set dayHeader = [A1].Resize(, lc)
For r = 20 To 71 Step 17
    Set fmtRng = Union(fmtRng, Cells(r, 2).Resize(13, lc - 2))
    Set dayHeader = Union(dayHeader, Cells(r - 2, 1).Resize(, lc))
Next
MsgBox fmtRng.Address(0, 0)
MsgBox dayHeader.Address(0, 0)
End Sub

The same method can be used to set your other ranges.

 

[footoo]

Have you considered creating a template so as to avoid so much code?
It seems to me that a lot of the cell values and formats being assigned by your macro could be set in a template.