Calculating Totals between two column headers - Macro VBA

[carefreeant88]

Morning,

Apologies, have another one I need help with!

I have a sheet that updates everyday; where the columns and their positions change each day.

I need to find a way of incorporating a Macro that ensure that the Total is calculated everyday, even though extra columns may have been added (or removed) from the tab.

So basically I need it to effectively do the following:

1. Look for the worksheet called BPS
2. If found, then look for the column header 'Total'
3. If found, then calculate the corresponding values of any columns BETWEEN the column header called 'Oversell' and the column header called 'Total'
   
   Apologies if I haven't explained that clearly. But hopefully the screenshot will explain what I mean better. On Day 1 (top table) the 'Totals' column would need to calculate between Columns 'B' and 'M. On Day 2 (middle table) the 'Totals' column would need to calculate between 'B' and 'Q'. On day 3 (bottom table), the 'Totals' column would need to calculate between Columns 'B' and 'J'. The number of columns on the data will change each day (thus the 'Totals' column will also move), hence why I think the way to achieve this would be for the Macro to 'search' for the column called 'Total', and the add the total sum of the corresponding columns etc.​

 

[offthelip]

I am not entirely clear about a few things, so I made some assumptions:
1: the row with Overall and Total in it is row1
2: The data will be in rows 2 onwards
3: the data will start in Column A
4: there will be data in column A for every row that is calculated
5: there are no gaps in the data
6: you want the result of the sum in the column withthe header "Total"
If these assumptions are wrong hopefully it is easy enough to change them to what you want, so try this:

Sub test()
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column ' find last column
lastrow = Cells(Rows.Count, "A").End(xlUp).Row         ' find last row

inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))  ' load all the data into an array
For i = 1 To lastcol
 If inarr(1, i) = "Overall" Then
  startcol = i
 End If
 If inarr(1, i) = "Total" Then
  endcol = i
 End If
Next i
For j = 2 To lastrow
totalsum = 0
For i = startcol To endcol - 1
 totalsum = totalsum + inarr(j, i)
Next i
Cells(j, i) = totalsum
Next j

 

End Sub

 

[carefreeant88]

I am not entirely clear about a few things, so I made some assumptions:
1: the row with Overall and Total in it is row1
2: The data will be in rows 2 onwards
3: the data will start in Column A
4: there will be data in column A for every row that is calculated
5: there are no gaps in the data
6: you want the result of the sum in the column withthe header "Total"
If these assumptions are wrong hopefully it is easy enough to change them to what you want, so try this:

Sub test()
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column ' find last column
lastrow = Cells(Rows.Count, "A").End(xlUp).Row         ' find last row

inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))  ' load all the data into an array
For i = 1 To lastcol
 If inarr(1, i) = "Overall" Then
  startcol = i
 End If
 If inarr(1, i) = "Total" Then
  endcol = i
 End If
Next i
For j = 2 To lastrow
totalsum = 0
For i = startcol To endcol - 1
 totalsum = totalsum + inarr(j, i)
Next i
Cells(j, i) = totalsum
Next j

 

End Sub

Everything you have assumed is correct (thank you!) but unfortunately it hasn't quite worked.

It seems to get to here, then 'loop back on itself' for want of a better phrase


If inarr(1, i) = "Overall" Then
startcol = i
End If
If inarr(1, i) = "Total" Then
endcol = i
End If
Next i

So it gets to the 'Next i' part of the code, but then loops back up to ' If inarr(1, i) = "Overall" Then' without moving any further forward.

Any idea why that might be the case? Apologies - a real novice when it comes to this kind of thing!

 

[offthelip]

What you describe is what it should be doing, it should complete a number of loops , from 1 to the lastcolumn in row 1 that has any data. As it searches every column if it comes across (Overall) or (Total) it saves the value of i in the variable startcol or endcol, which are then used to the 2nd loop below. You say it hasn't quite worked what does it do??

 

[offthelip]

I have just spotted what might be the error, I thought you were looking for "Overall" when I take a look at your picure again I see it says "Oversell" so change the line

If inarr(1, i) = "Overall" Then

to

If inarr(1, i) = "Oversell" Then

 

[Fuji]

1. Look for the worksheet called BPS
2. If found, then look for the column header 'Total'
3. If found, then calculate the corresponding values of any columns BETWEEN the column header called 'Oversell' and the column header called 'Total'​

try

Sub test()
    Dim x, LR&
    If Not [isref('BPS'!a1)] Then MsgBox "No ""BPS"" sheet": Exit Sub
    With Sheets("BPS")
        x = Filter(Application.IfError(Application.Match(Array("oversell", "total"), .Rows(1), 0), False), False, 0)
        If UBound(x) <> 1 Then MsgBox "Missing header(s)": Exit Sub
        With Intersect(.UsedRange, .Columns(x(0) + 1).Resize(, x(1) - x(0) - 1))
            LR = .Parent.Evaluate(Replace("max(if(#<>"""",row(#)))", "#", .Address))
        End With
        If LR > 1 Then .Cells(2, Val(x(1))).Resize(LR - 1).FormulaR1C1 = "=sum(rc" & x(0) + 1 & ":rc[-1])"
    End With
End Sub

 

[carefreeant88]

try

Sub test()
    Dim x, LR&
    If Not [isref('BPS'!a1)] Then MsgBox "No ""BPS"" sheet": Exit Sub
    With Sheets("BPS")
        x = Filter(Application.IfError(Application.Match(Array("oversell", "total"), .Rows(1), 0), False), False, 0)
        If UBound(x) <> 1 Then MsgBox "Missing header(s)": Exit Sub
        With Intersect(.UsedRange, .Columns(x(0) + 1).Resize(, x(1) - x(0) - 1))
            LR = .Parent.Evaluate(Replace("max(if(#<>"""",row(#)))", "#", .Address))
        End With
        If LR > 1 Then .Cells(2, Val(x(1))).Resize(LR - 1).FormulaR1C1 = "=sum(rc" & x(0) + 1 & ":rc[-1])"
    End With
End Sub

So this has nearly worked.

It is definitely doing exactly what I need it to do. However, it is only going down as far as row 23,668.

On the example I am using this morning to test this, I have data as far as rows 23,743,

Do you have any idea as to why it may only be going as far as 23,668?

Thanks (and sorry to bother you again!)

 

[Fuji]

try change

        With Intersect(.UsedRange, .Columns(x(0) + 1).Resize(, x(1) - x(0) - 1))

to

        With Intersect(.UsedRange, .Columns(Val(x(0))).Resize(, x(1) - x(0) + 1))

And see if this works as you want.

 

[carefreeant88]

try change

        With Intersect(.UsedRange, .Columns(x(0) + 1).Resize(, x(1) - x(0) - 1))

to

        With Intersect(.UsedRange, .Columns(Val(x(0))).Resize(, x(1) - x(0) + 1))

And see if this works as you want.

Perfect! Thank you so much for your help

 

[Fuji]

You are welcome and thanks for the feedback.