Solved: Dynamic Ranges

[Slicemahn]

Hi Everyone!

I am reposting this question because I have run into another problem. I have attached the spreadsheet to this post. Here is the code I have used:
Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim cell As Range
Dim FirstAddress As String
With ActiveSheet

If Right(ActiveSheet.Name, 6) = "E-mail" Then
Exit Sub
End If



' Need to insert another column to place percentages
.Columns("E:E").Insert Shift:=xlToRight
.Cells(9, 5).Value = "% of Total"
.Columns(5).NumberFormat = "0.0%"

.Cells(10, 1).Activate


LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("E10").Resize(LastRow - 1).Formula = "=IF(ISERROR(IF(ISNUMBER(SEARCH(""Total"",B10)),"""",D10/SUMIF(B:B,B10,D:D))),"""",IF(ISNUMBER(SEARCH(""Total"",B10)),"""",D10/SUMIF(B:B,B10,D:D)))"
Set cell = .Columns(2).Find("Total", LookIn:=xlValues, LookAT:=xlPart)
i = 10
If Not cell Is Nothing Then
FirstAddress = cell.Address
Do
If cell.Row < LastRow Then
cell.Offset(0, 6).Formula = "=SUM(H" & i & ":H" & cell.Row - 1 & ")"
End If
i = cell.Row + 1
Set cell = .Columns(2).FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> FirstAddress
End If
End With

End Sub

Which works out; however when I look at my sheet the % of Total is calculated for all Cable instances. I would like to calculate % of Total within a Location.

[Bob Phillips]

Is thius what you are after?



Option Explicit

Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim cell As Range
Dim FirstAddress As String
With ActiveSheet

If Right(ActiveSheet.Name, 6) = "E-mail" Then
Exit Sub
End If

' Need to insert another column to place percentages
.Columns("E:E").Insert Shift:=xlToRight
.Cells(9, 5).Value = "% of Total"
.Columns(5).NumberFormat = "0.0%"

.Cells(10, 1).Activate


LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("E10").Resize(LastRow - 1).Formula = "=IF(ISERROR(IF(ISNUMBER(SEARCH(""Total"",B10)),"""",D10/SUMIF(B:B,B10,D:D))),"""",IF(ISNUMBER(SEARCH(""Total"",B10)),"""",D10/SUMIF(B:B,B10,D:D)))"
Set cell = .Columns(2).Find("Total", LookIn:=xlValues, LookAT:=xlPart)
i = 10
If Not cell Is Nothing Then
FirstAddress = cell.Address
Do
If cell.Row < LastRow Then
cell.Offset(0, 6).Formula = "=G" & cell.Row & "/D" & cell.Row
End If
i = cell.Row + 1
Set cell = .Columns(2).FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> FirstAddress
End If
End With

End Sub

[Slicemahn]

Not quite xld. Your line of code starting with:

cell.Offset(0, 6).Formula = "=G" & cell.Row & "/D" & cell.Row

appears to be the problem. I am happy with my code :

cell.Offset(0, 6).Formula = "=SUM(H" & i & ":H" & cell.Row - 1 & ")"

because all I want to do there is add up the values for that column but this is where I struggle:

Taking the AGENT.NAME1 in Brampton, I need to calculate the percentage of the total. In this case it would be 18/4124. And down the line. However, with your sumif formula, the criteria being used is Cable and as a result the calculation for % of total will be wrong because it includes Cable from Moncton as well. I want the % of Totals for each location and area on its own. Therefore when we add cells e10:e42 it must always equal 100%. With your code, the total is only 97.3%

[Slicemahn]

Sorry my code should read:

cell.Offset(0, 6).Formula = "=SUM(G" & i & ":G" & cell.Row - 1 & ")"

[Bob Phillips]

Now you are really losing me Slice.

Are you saying -
- that you want to calculate each value in column G, row 10, 11, etc., even Area/Location totals?
- do you want sums calculated?
- will that column E be there as the code adds another?

Why don't you re-post the workbook with the correct start columns, cells you want calculated highlighted some colour, and a few example results. Dhould be able to work it from there.

[Slicemahn]

I hope this clarifies things. No I don't want column G summed up so my correction needs to be corrected. Column H should be summed up. I have reattached a sample worksheet with the columns in orange I would like to be automated.

[Bob Phillips]

I must be thick Slice, because if I remove column E, that previous code calculates everything just as you (seem to) want.

SO what am I missing?

[Slicemahn]

It doesn't. If you add up the percentages they don't equal 100%.

[Bob Phillips]

Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim cell As Range
Dim FirstAddress As String
With ActiveSheet

If Right(ActiveSheet.Name, 6) = "E-mail" Then
Exit Sub
End If

' Need to insert another column to place percentages
.Columns("E:E").Insert Shift:=xlToRight
.Cells(9, 5).Value = "% of Total"
.Columns(5).NumberFormat = "0.0%"

.Cells(10, 1).Activate

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("E10").Resize(LastRow - 1).Formula = _
"=IF(ISERROR(IF(ISNUMBER(SEARCH(""Total"",B10)),""""," & _
"D10/SUMPRODUCT(--($A$10:$A$" & LastRow & "=A10),--($B$10:$B$" & LastRow & "=B10),$D$10:$D$" & LastRow & "))),""""," & _
"IF(ISNUMBER(SEARCH(""Total"",B10)),""""," & _
"D10/SUMPRODUCT(--($A$10:$A$" & LastRow & "=A10),--($B$10:$B$" & LastRow & "=B10),$D$10:$D$" & LastRow & ")))"
Set cell = .Columns(2).Find("Total", LookIn:=xlValues, LookAT:=xlPart)
i = 10
If Not cell Is Nothing Then
FirstAddress = cell.Address
Do
If cell.Row < LastRow Then
cell.Offset(0, 6).Formula = "=SUM(H" & i & ":H" & cell.Row - 1 & ")"
End If
i = cell.Row + 1
Set cell = .Columns(2).FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> FirstAddress
End If
End With

End Sub

[Slicemahn]

Sweeet! This works out excellent. xld thanks once again for your help!