Repeat headers without loops

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Repeat headers without loops

Post by YasserKhalil »

Hello everyone
In the following code the headers [Date] & [DC] are repeated five times

Code: Select all

Sub RepeatHeaders()
    Dim i As Long
    Dim headerText(1)
    headerText(0) = "Date": headerText(1) = "DC"
    For i = 2 To 11
        Cells(1, i).Value = headerText(i Mod 2)
    Next i
End Sub
Is there a more smart approach to do the same without loops?

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Repeat headers without loops

Post by HansV »

Code: Select all

Sub RepeatHeaders()
    With Range("B1:K1")
        .Formula = "=IF(ISEVEN(COLUMN()),""Date"",""DC"")"
        .Value = .Value
    End With
End Sub
or of course

Code: Select all

Sub RepeatHeaders()
    Range("B1:K1").Value = Array("Date", "DC", "Date", "DC", "Date", "DC", "Date", "DC", "Date", "DC")
End Sub
:grin:
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Re: Repeat headers without loops

Post by YasserKhalil »

Amazing, especially the last suggestion :)

Code: Select all

Sub RepeatHeaders()
    Const N As Long = 5
    With Range("B1").Resize(, N * 2)
        .Value = Evaluate("IF(ISEVEN(COLUMN(" & .Address & ")),""Date"",""DC"")")
    End With
End Sub

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Re: Repeat headers without loops

Post by YasserKhalil »

Another point if possible. I need to store the headers in 1d array `Array("Date", "DC")` and modify my last code to implement them. Of course the number of items will be dynamic (not always two items).

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Re: Repeat headers without loops

Post by YasserKhalil »

I have tried such code but no way

Code: Select all

Sub RepeatHeaders()
    Const N As Long = 5
    With Range("B1").Resize(, N * 2)
        .Value = Application.Transpose(Evaluate("TRANSPOSE(INDEX({""Name"",""Age"",""Notes"", ""Address"", ""Phone Number""}, MOD(COLUMN(" & .Address & ")-2,5)+1))"))
    End With
End Sub

I couldn't adjust it

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Repeat headers without loops

Post by HansV »

In Excel in Microsoft 365 and Office 2021, you can use

Code: Select all

Sub RepeatHeaders()
    Const N As Long = 3
    Dim L As Long
    Dim a As Variant
    Dim s As String
    a = Array("Name", "Age", "Notes", "Address", "Phone Number")
    L = UBound(a) + 1
    s = "{""" & Join(a, """,""") & """}"
    With Range("B1").Resize(, N * L)
        Range("B1").Formula2 = "=INDEX(" & s & ", MOD(COLUMN(" & .Address & ")-2," & L & ")+1)"
        .Value = .Value
    End With
End Sub
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Repeat headers without loops

Post by HansV »

I older versions (I hope):

Code: Select all

Sub RepeatHeaders()
    Const N As Long = 3
    Dim L As Long
    Dim a As Variant
    Dim s As String
    a = Array("Name", "Age", "Notes", "Address", "Phone Number")
    L = UBound(a) + 1
    s = "{""" & Join(a, """,""") & """}"
    With Range("B1").Resize(, N * L)
        .FormulaArray = "=INDEX(" & s & ", MOD(COLUMN(" & .Address & ")-2," & L & ")+1)"
        .Value = .Value
    End With
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Re: Repeat headers without loops

Post by YasserKhalil »

the code is perfect for the case cell is B1 but try to change different cells A1, F1, G1 the output will be different and the formula has to be changed manually each time.
I tried to make it as public procedure but I couldn't adjust the cell output

Code: Select all

Sub RepeatHeaders(ByVal N As Long, ByVal headerText, ByVal outputCell As Range)
    Dim a, s As String, l As Long
    l = UBound(headerText) + 1
    s = "{""" & Join(headerText, """,""") & """}"
    With outputCell.Resize(, N * l)
        .FormulaArray = "=INDEX(" & s & ", MOD(COLUMN(" & .Address & ")-" & outputCell.Column - 1 & "," & l & "))"
        .Value = .Value
    End With
End Sub

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Repeat headers without loops

Post by HansV »

This should work:

Code: Select all

Sub RepeatHeaders(ByVal N As Long, ByVal headerText, ByVal outputCell As Range)
    Dim a, s As String, l As Long
    l = UBound(headerText) + 1
    s = "{""" & Join(headerText, """,""") & """}"
    With outputCell.Resize(, N * l)
        .FormulaArray = "=INDEX(" & s & ", MOD(COLUMN(" & .Address & ")-" & outputCell.Column & "," & l & ")+1)"
        .Value = .Value
    End With
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4939
Joined: 31 Aug 2016, 09:02

Re: Repeat headers without loops

Post by YasserKhalil »

That's exactly what I imagined. Thank you very much.
Best Regards