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

Bering

Board Regular
Joined
Aug 22, 2018
Messages
105
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
According to your image, the formulas go in row 5 and the headers in row 2, try this

VBA Code:
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
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Bering

Board Regular
Joined
Aug 22, 2018
Messages
105
Office Version
  1. 2016
Platform
  1. Windows
Brilliant! Many thanks for your help


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

VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,112,771
Messages
5,542,433
Members
410,552
Latest member
Yogesh977
Top