VBA insert n new columns and calculate difference of previous n-2 columns

[Bering]

Hello,

I have a workbook with 2 worksheets: in sheet1, column B, users enter a list of items (the number of item can vary but the last item is always called Total).
For each item in that list, a macro adds a corresponding column in sheet2 (headers = item) plus an additional one, unrelated to the list. The macro will also insert some formulae in each new column in sheet2 (row 6 to 53).

Example: in sheet2 there are 20 columns, the user enters 4 items in sheet1, the macro will create 5 additional columns, hence 25 in total.
For the last item in the list in sheet1, which is always called Total, I would like to add in the corresponding column in sheet2, a formula that calculates the difference of the n- 2 previous columns (3 in this example): item Total would correspond to Column 24 and I would like to populate the range row 6 to 53 with a formula: Column 21 - Column 22 - Column 23

I am not sure how I could achieve this.

Many thanks in advance

 

[DanteAmor]

According to your image, the formulas go in row 5 and the headers in row 2, try this

Sub insert_new_columns()
  Dim f As Range, lc As Long, n As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sLet As String
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  
  Set f = sh1.Range("B:B").Find("Total", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    With sh1.Range("B2", f)
      .Copy
      n = .Rows.Count - 1
    End With
    If n > 0 Then
      lc = sh2.Cells(2, Columns.Count).End(1).Column + 1
      sLet = Split(Cells(1, lc).Address, "$")(1)
      sh2.Cells(2, lc).PasteSpecial xlPasteValues, , , True
      With sh2.Cells(5, lc + n)
        If n = 1 Then
          .Formula = "=" & .Offset(0, -n).Address(0, 0)
        Else
          .Formula = "=" & .Offset(0, -n).Address(0, 0) & "-SUM(" & .Offset(0, -n + 1).Address(0, 0) & ":" & .Offset(0, -1).Address(0, 0) & ")"
          With sh2.Range(sh2.Cells(5, lc), sh2.Cells(52, lc + n - 1))
            .Formula = "=$E5*" & sLet & "$4"
          End With
        End If
        .Copy sh2.Range(sh2.Cells(5, lc + n), sh2.Cells(52, lc + n))
      End With
      '
    Else
      MsgBox "No items"
    End If
  Else
    MsgBox "The item 'Total' does not exist"
  End If
End Sub

 

[Bering]

Brilliant! Many thanks for your help

According to your image, the formulas go in row 5 and the headers in row 2, try this

Sub insert_new_columns()
  Dim f As Range, lc As Long, n As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sLet As String
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
 
  Set f = sh1.Range("B:B").Find("Total", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    With sh1.Range("B2", f)
      .Copy
      n = .Rows.Count - 1
    End With
    If n > 0 Then
      lc = sh2.Cells(2, Columns.Count).End(1).Column + 1
      sLet = Split(Cells(1, lc).Address, "$")(1)
      sh2.Cells(2, lc).PasteSpecial xlPasteValues, , , True
      With sh2.Cells(5, lc + n)
        If n = 1 Then
          .Formula = "=" & .Offset(0, -n).Address(0, 0)
        Else
          .Formula = "=" & .Offset(0, -n).Address(0, 0) & "-SUM(" & .Offset(0, -n + 1).Address(0, 0) & ":" & .Offset(0, -1).Address(0, 0) & ")"
          With sh2.Range(sh2.Cells(5, lc), sh2.Cells(52, lc + n - 1))
            .Formula = "=$E5*" & sLet & "$4"
          End With
        End If
        .Copy sh2.Range(sh2.Cells(5, lc + n), sh2.Cells(52, lc + n))
      End With
      '
    Else
      MsgBox "No items"
    End If
  Else
    MsgBox "The item 'Total' does not exist"
  End If
End Sub

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.