VBA Code - Add New Columns with Named Headers & Populate with Formulas

[mbagz]

Hey, I am trying to create a dynamic table in excel using VBA based on some primary fields:

Quantity	Frequency	StartDate	EndDate	Total Timepoints	New Column 1	....	....	New Column 8
5	Weekly	04/15/2021	05/13/2021	=If(Frequency = "weekly", Days(EndDate,StartDate)/7,,)
10	Weekly	04/15/2021	06/10/2021	=If(Frequency = "weekly", Days(EndDate,StartDate)/7,,)

I'd like to setup some VBA code to:
1) Find the max number of timepoint in column "Total Timepoints" & define as "ColNum"
2) Create New Columns (Based on ColNum +1)
3) Name New Columns by Day 0, Day 7, Day 14, Day 21...Day 56
4) Populate rows of new columns with "Quantity" specified for that row, but only up to that rows Total Timepoints +1. For example the 2nd row in the above table should have "5" for each cell from new columns created (Day 0, Day 7, Day 14, Day 21, Day 28); Row 3 should have quantity "10" for each cell from new columns (Day 0, Day 7,...,Day 56)

So far, I have the below, but I have no idea what I'm doing so any help would be really appreciated:

Sub AutoAddColumns()

Dim Table As ListObject
Dim NumOfColumns As Integer
Dim iCnt As Integer
Dim h As Long, hdrs As Variant
Dim Rows As Integer

hdrs = Array("Day 0", "Day 7", "Day 14", "Day 21", "Day 28", "Day 35", "Day 42", "Day 49", "Day 56", "Day 63", "Day 70", "Day 77", "Day 84", "Day 91", "Day 98", "Day 105", "Day 112", "Day 119", "Day 126", "Day 133", "Day 140", "Day 147")

Set Table = Worksheets("Sheet1").ListObjects("TableName")

NumOfColumns = Application.WorksheetFunction.Max(Range("TableName[Total Timepoints]"))

For iCnt = 0 To NumOfColumns
        Table.ListColumns.Add
        Table.ListColumns(Table.ListColumns.Count).Name = hdrs(iCnt)
    Next

End Sub

 

[mse330]

Hi mbagz,

Try below code to add the columns ...

Sub test()

With ActiveSheet
   Lc& = .Cells(1, Columns.Count).End(1).Column + 1
   Cnt& = (Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7
   .Cells(1, Lc).Resize(, Cnt) = [transpose("Day "&row(1:50)*7)]
End With

End Sub

 

[mse330]

Just noticed that I missed the last point to copy the values from column 1. Try revised code below ...

Sub test2()

With ActiveSheet
   Lc& = .Cells(1, Columns.Count).End(1).Column + 1
   Cnt& = (Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7
   .Cells(1, Lc).Resize(, Cnt) = [transpose("Day "&row(1:50)*7-7)]
   Lr& = .Cells(Rows.Count, 1).End(3).Row - 1
   .Cells(2, Lc).Resize(Lr).Resize(, Cnt) = .Cells(2, 1).Resize(Lr).Value
End With

End Sub

 

[mbagz]

Just saw your last post. so I'm editing my comment. Thanks for addressing everything!

1) The number of columns created should be total timepoints +1, but I can edit this
2) For the quantity entered, it should be input up to the total timepoints +1. For example, The first row should have "5" input for Day 0, Day 7, Day 14, Day 21, and Day 28. Could you help with this part?
3) Is there a way to specify this code to a named table? This data may not be always static on the sheet, so I'm trying to see if coding it to the table is possible.

 

[mse330]

This should take care of all your points

Sub test3()

With ActiveSheet.ListObjects(1).DataBodyRange
   Lc& = .Columns.Count + 1
   Cnt& = (Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7
   .Cells(1, Lc).Resize(, Cnt) = ""
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose("Day "&row(1:50)*7-7)]
   Lr& = .Rows.Count
   .Cells(1, Lc).Resize(Lr).Resize(, Cnt) = .Cells(1, 1).Resize(Lr).Value
End With

End Sub

 

[mbagz]

This should take care of all your points

Sub test3()

With ActiveSheet.ListObjects(1).DataBodyRange
   Lc& = .Columns.Count + 1
   Cnt& = (Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7
   .Cells(1, Lc).Resize(, Cnt) = ""
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose("Day "&row(1:50)*7-7)]
   Lr& = .Rows.Count
   .Cells(1, Lc).Resize(Lr).Resize(, Cnt) = .Cells(1, 1).Resize(Lr).Value
End With

End Sub

Hey mse330,

It's still adding the quantity all the way through the table. Ideally, I'd like it to add "5" quantity from row 2 for the new 5 columns added (4 total timepoints +1). For quantity "10", it should add it all the way from new column 1 to new column 9 (8 total timepoints +1). Unfortunately, this code goes over my head, so I don't know how to modify that.

Thanks again!

 

[mse330]

Assuming you have a formula to count total timepoints in column 5 ...

Sub test4()

Dim c As Range

With ActiveSheet.ListObjects(1).DataBodyRange
   Cnt& = ((Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7) + 1
   .Cells(1, .Columns.Count + 1).Resize(, Cnt) = ""
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose(row(1:50))]
   
   Set c = .Cells(1)
   With .Offset(, 5).Resize(, Cnt)
      .Formula = "=if(" & c.Offset(, 4).Address(0, 1) & "+1>=" & .Cells(1).Offset(-1).Address(1, 0) & "+0," & c.Address(0, 1) & ","""")"
      .Value = .Value
   End With
   
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose("Day "&row(1:50)*7-7)]
End With

End Sub

 

[mbagz]

Assuming you have a formula to count total timepoints in column 5 ...

Sub test4()

Dim c As Range

With ActiveSheet.ListObjects(1).DataBodyRange
   Cnt& = ((Application.Max(.Columns(4)) - Application.Min(.Columns(3))) / 7) + 1
   .Cells(1, .Columns.Count + 1).Resize(, Cnt) = ""
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose(row(1:50))]
  
   Set c = .Cells(1)
   With .Offset(, 5).Resize(, Cnt)
      .Formula = "=if(" & c.Offset(, 4).Address(0, 1) & "+1>=" & .Cells(1).Offset(-1).Address(1, 0) & "+0," & c.Address(0, 1) & ","""")"
      .Value = .Value
   End With
  
   .Parent.ListObjects(1).HeaderRowRange.Offset(, 5).Resize(, Cnt) = [transpose("Day "&row(1:50)*7-7)]
End With

End Sub

That works perfectly! Thank you so much!

 

[mse330]

Glad to help & thanks for the feedback