Repeat headers without loops

[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?

[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

[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]

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]

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

[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

[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

[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

[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

[YasserKhalil]

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