Generate Subtotal Summary from Sheet1 into Sheet2

[u473]

Within the same workbook, I want to summarize
by Project the "Detail" worksheet into the "Summary" worksheet.
I probably have a range syntax error, but I cannot detect it.
I have an Overflow error and the Countif that drives the loop is at
zero.
..
I could easily do it with a pivot table, that is not what I want.
I want to process it with VBA as I have attempted below.
Help appreciated.
J.P.
.............................................
Source : "Detail" worksheet
A B C D
E
1. Date Project Activity Force Hours
2. 8/27/2010 Project C T 5 300
3. 8/29/2010 Project C U 10 500
4. 8/26/2010 Project A L 1 50
5. 8/28/2010 Project A M 11 550
6. 8/23/2010 Project K V 4 200
7. 8/25/2010 Project K X 6 300
...........................................
Destination : "Destination" worksheet
Project Force Hours
Project A 12 600
Project C 15 800
Project K 10 500
...........................................
Sub ProjectSummary()
Dim WB As Workbook
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim MyPath, Line As String
Dim DestCell As Range
Dim i As Integer: Dim j As Integer: Dim k As Integer
Dim RngD As Range
Dim RngE As Range
Dim RngB As Range
On Error GoTo ErrorCatch
MyPath = "C:\1-Work\TestData\"
Set WB = Workbooks.Open(MyPath & "Omega.xls")
Set SH1 = WB.Worksheets("Detail")
Set SH2 = WB.Worksheets("Summary")
Set DestCell = SH2.Range("A1")
ActiveWorkbook.Sheets("Detail").Select
DestCell = "Project"
DestCell.Offset(0, 1) = "Force"
DestCell.Offset(0, 2) = "Hours"
'------------------------------------------
'Sort rows by Project
SH1.Range("A2").CurrentRegion.Sort Key1:=SH1.Range("B2"),
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=False, Orientation:=xlTopToBottom
'=================== Probable Error Area =========================
Set RngD = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
Set RngE = Range(Cells(1, "E"), Cells(Rows.Count, "E").End(xlUp))
Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp))
' Calculate Sum for Project
Line = "Do While"
Do While i <= Worksheets("Detail").Range("A100").End(xlUp).Row
j = Application.CountIf(RngB, Cells(i, "B"))
Line = j & " Summary Col. A " 'Error is there : Overflow message
and J = 0
'=======================================================
Worksheets("Summary").Cells(k, "A") = Cells(i, "B")
Worksheets("Summary").Cells(k, "B") = Application.SumIf(RngB,
Cells(i, "B"), RngD)
Worksheets("Summary").Cells(k, "C") = Application.SumIf(RngB,
Cells(i, "B"), RngE)
k = k + 1: i = i + j
Loop
Exit Sub
ErrorCatch:
MsgBox "ErrorCatch Line : " & Line & " " & Err.Description
Resume Next
End Sub

 

[Charabeuh]

Hello !

I notice two things:

An error of syntax:
replace Cells(1, "B") by Cells(1, 2)
replace Cells(1, "C") by Cells(1, 3)
replace Cells(1, "D") by Cells(1, 4)
replace Cells(1, "E") by Cells(1, 5)

and a logical one:
before using a loop, one should initialize the variable used for staying in
the loop or stopping it.
In your case, i and k are initialized to zero (default value)
You should write:

i = 2
k = 2
Do While i <= Worksheets("Detail").Range("A100").End(xlUp).Row

The modified code:

Sub ProjectSummary()
Dim WB As Workbook
Dim SH1 As Worksheet, SH2 As Worksheet
Dim MyPath, Line As String
Dim DestCell As Range
Dim i As Integer, j As Integer, k As Integer
Dim RngD As Range, RngE As Range, RngB As Range

On Error GoTo ErrorCatch
MyPath = "C:\1-Work\TestData\"
Set WB = ThisWorkbook ' Workbooks.Open(MyPath & "Omega.xls")
Set SH1 = WB.Worksheets("Detail")
Set SH2 = WB.Worksheets("Summary")
Set DestCell = SH2.Range("A1")
ActiveWorkbook.Sheets("Detail").Select
DestCell = "Project"
DestCell.Offset(0, 1) = "Force"
DestCell.Offset(0, 2) = "Hours"

'Sort rows by Project
SH1.Range("A2").CurrentRegion.Sort Key1:=SH1.Range("B2"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

Set RngD = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
Set RngE = Range(Cells(1, "E"), Cells(Rows.Count, "E").End(xlUp))
Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp))
' Calculate Sum for Project
i = 2
k = 2
Do While i <= Worksheets("Detail").Range("A100").End(xlUp).Row
j = Application.CountIf(RngB, Cells(i, 2))
Line = j & " Summary Col. A "
Worksheets("Summary").Cells(k, 1) = Cells(i, 2)
Worksheets("Summary").Cells(k, 2) = Application.SumIf(RngB, _
Cells(i, 2), RngD)
Worksheets("Summary").Cells(k, 3) = Application.SumIf(RngB, _
Cells(i, 2), RngE)
k = k + 1: i = i + j
Loop
Exit Sub

ErrorCatch:
MsgBox Err.Description
End Sub


Does it help ?

 

[Charabeuh]

Errata:

Replace the line:
Set WB = ThisWorkbook ' Workbooks.Open(MyPath & "Omega.xls")
with your initial line:
Set WB = Workbooks.Open(MyPath & "Omega.xls")

And if you want your macro run more than once, you could erase the old
results before the new calculation. Just insert this line:
Range(DestCell, DestCell.End(xlDown).Resize(, 3)).ClearContents
after the line:
Set DestCell = SH2.Range("A1")

 

[u473]

Sorry, I still have the Overflow error.
However, I agree with you for the i & k not being initialized,
after I posted my code, I deleted unnecessary comments,
and that line was deleted by mistake.
I am still scratching my head, because I have used that code before.
J.P.

 

[Charabeuh]

Hello !

It is very strange.
By me, with your code and with the initialization of i and k and without any
other change, your code is working perfectly. Did you run your code step by
step and check before executing the line where the error occurs all the
values of the different variables (i,j,k;Cells(i, "B")...etc) ?

 

[u473]

Thank you for your response.
I am still debugging step by step.

 

[u473]

After testing, this is what I have found do far :

1. The execution of this code is launched from : C:\1-Work\TestData
\P1\ReOrg.xls
2. Everything works fine thru currentregion.sort
3. However, when I try to test the value of Cells(Rows.Count,
"D").End(xlUp) for RngD
I find that it is counting rows in ReOrg book instead of SH1
4. So far my various attempts to activate SH1 or
WB.Worksheets("Detail") have been unsuccesful
I do not understand why just before the Set RngD, the sorting
works well in the "Detail" sheet
and then it switches reference to ReOrg book.
I understand I am doing something wrong in my referencing, but I
have not found where yet.

 

[Charabeuh]

What about using the "With ... End With" statement ?
The code :

Sub ProjectSummary()

Dim WB As Workbook
Dim SH1 As Worksheet, SH2 As Worksheet
Dim MyPath, Line As String
Dim DestCell As Range
Dim i As Integer, j As Integer, k As Integer
Dim RngD As Range, RngE As Range, RngB As Range

On Error GoTo ErrorCatch

MyPath = "C:\1-Work\TestData\"
Set WB = Workbooks.Open(MyPath & "Omega.xls")

Set SH1 = WB.Worksheets("Detail")
Set SH2 = WB.Worksheets("Summary")
Set DestCell = SH2.Range("A1")

DestCell = "Project"
DestCell.Offset(0, 1) = "Force"
DestCell.Offset(0, 2) = "Hours"

'Sort rows by Project
With SH1
.Range("A2").CurrentRegion.Sort Key1:=.Range("B2"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

Set RngD = .Range(.Cells(1, "D"), .Cells(.Rows.Count, "D").End(xlUp))
Set RngE = .Range(.Cells(1, "E"), .Cells(.Rows.Count, "E").End(xlUp))
Set RngB = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp))

' Calculate Sum for Project
i = 2: k = 2
Do While i <= .Range("A100").End(xlUp).Row
j = Application.CountIf(RngB, .Cells(i, "B"))
SH2.Cells(k, "A") = .Cells(i, "B")
SH2.Cells(k, "B") = Application.SumIf(RngB, .Cells(i, "B"), RngD)
SH2.Cells(k, "C") = Application.SumIf(RngB, .Cells(i, "B"), RngE)
k = k + 1: i = i + j
Loop
End With
SH2.Select
Exit Sub

ErrorCatch:
MsgBox Err.Description
End Sub

 

[u473]

Merci, Merci, Merci. You made my day.
That was a great lesson. It works fine.
If possible, I'd like to refer to you in the future.
J.P.

 

[u473]

Last stretch...
the above code works perfect.
Now, I am trying Rows Total and Columns Totals
....
....
Loop
End With
SH2.Select
SH2.Cells(k, "A") = "Grand Total": Rows("1:1").Font.Bold = True:
Range("B11").HorizontalAlignment = xlRight
'Place row totals in Column D. Reference Error there
-----------------------------------------------------------------------------
For i = 2 To k
'SH2.Cells(i, "D").Value = Application.Sum(Range(Cells(i, "B"),
Cells(i, "C")))
Next i
'Place Columns totals in row k.
-------------------------------------------
For i = 2 To 4
SH2.Cells(k, i).Value = Application.Sum(Range(Cells(2, i), Cells(k,
i)))
Next i
Row(k).Font.Bold = True ' Error . How do I refer to the whole row with
a variable ?
Exit Sub

 

[Charabeuh]

Try this:
....
....
Loop
End With

With SH2
.Cells(k, "A") = "Grand Total"
.Rows("1:1").Font.Bold = True
.Range("B11").HorizontalAlignment = xlRight

For i = 2 To k
.Cells(i, "D").Value = Application.Sum(Range(.Cells(i, "B"),
..Cells(i, "C")))
Next i

For i = 2 To 4
.Cells(k, i).Value = Application.Sum(Range(.Cells(2, i), .Cells(k,
i)))
Next i
.Rows(k).Font.Bold = True
End With

SH2.Activate
Exit Sub

It is not a good thing to format an entire row if it is not useful
=> it could increase the necessary ressources to manage your excel file.

You can replace .Rows("1:1").Font.Bold = True
with: .Range("A11").Font.Bold = True

and replace .Rows(k).Font.Bold = True
with .Range("A" & k & "" & k).Font.Bold = True

 

[u473]

We are getting closer, but we have two similar errors in the summing:
First : Method 'Range' of object '_worksheet' failed
Second = Application-defined or object-defined error
..
I tried : .Cells(i, "D").Formula = "=Sum(Range(.Cells(i,
'B'), .Cells(i, 'C')))"
.Cells(i, "D").Value =
Application.worksheet.Sum(Range(.Cells(i, "B"), .Cells(i, "C")))
without success. do I have to change anything in the
Reference Library ?
..
For i = 2 To k - 1 ' k-1 since k is the Total Row itself
.Cells(i, "D").Value = Application.Sum(Range(.Cells(i,
"B"), .Cells(i, "C")))
Next i
For i = 2 To 4
.Cells(k, i).Value = Application.Sum(Range(.Cells(2,
i), .Cells(k - 1, i))) ' k-1 again
Next i
Thank you again for your help. where are you located ?

 

[Charabeuh]

The following code is working by me:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 2 To k - 1
..Cells(i, "D").Value = Application.Sum(Range(.Cells(i, "B"), .Cells(i,
"C")))
'or
..Cells(i, "D").Formula = "=Sum(" & Range(.Cells(i, "B"), .Cells(i,
"C")).Address(False, False) & ")"
Next i

For i = 2 To 4
..Cells(k, i).Value = Application.Sum(Range(.Cells(2, i), .Cells(k - 1, i)))
'or
..Cells(k, i).Formula = "=Sum(" & Range(.Cells(2, i), .Cells(k - 1,
i)).Address(False, False) & ")"
Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

if you write:
.Cells(i, "D").Formula = "=Sum(Range(.Cells(i,'B'), .Cells(i, 'C')))"

1- The result is the string: =Sum(Range(.Cells(i,'B'), .Cells(i, 'C')))
This string is not a valid formula.

2- if you want to insert a " into a litteral string you must double it ""
ex: A="cells(i,""B"")" not A="cells(i,"B")" and not A="cells(i,'B')"

The parameter of a sum formula is the address of the range of the values to
sum.
Something like: =SUM(B2:C2)

To build the string of the formula, you can use:
Formula = "SUM(" & Address of MyRange & ")"

To get the address of the range, you can use:
Asolute address ==>MyRange.Address
or relative address ==>MyRange.Address(False,False)

So the you can write:
Formula =
"SUM(" & MyRange.Address(False,False) & ")"

3- you wrote:
.Cells(i, "D").Value =
Application.worksheet.Sum(Range(.Cells(i, "B"), .Cells(i, "C")))

Sum is not a method of a worksheet. Prefer :
Application.WorksheetFunction.Sum(Range(.Cells(i, "B"), .Cells(i, "C")))
or
Application.Sum(Range(.Cells(i, "B"), .Cells(i, "C")))

 

[Charabeuh]

Errata !

The formula of the sum should be:
Formula =
"=SUM(" & MyRange.Address(False,False) & ")"

(I forgot the equal sign in the string of the formula!)

and not:
Formula =
"SUM(" & MyRange.Address(False,False) & ")"

 

[u473]

Ok, I was careful in copy/pasting and testing those 3 syntaxes in
Debug mode,
a .Cells(i, "D").Value = Application.Sum(Range(.Cells(i,
"B"), .Cells(i, "C")))
b .Cells(i, "D").Formula = "=Sum(" & Range(.Cells(i, "B"), .Cells(i,
"C")).Address(False, False) & ")"
c .Cells(i, "D").Value =
Application.WorksheetFunction.Sum(Range(.Cells(i, "B"), .Cells(i,
"C")))
..
Each time I keep getting this error on either of these syntaxes :
Method 'Range' of object '_worksheet' failed
This Error message puzzles me.
I use Excel 2003 and the execution is launched from an external
workbook.
I repeat, would I have to change anything in the Reference Library ?
Execution goes perfect until I hit those summing lines, and I checked
that I am within the With SH2 / End With structure.
Next, I will try to replace for testing purpose, the variables with
hard values/

1:00 AM Monday Morning in Texas. Have a Good Day.
J.P.

 

[norie]

Try putting a dot qualifier (.) in front of Range, just like you have
for Cells.

 

[u473]

Wooowwww !!!! That did it. For me that was an extremely vicious error.
I will remember it.
Thank you, thank you both. You made my day.
Now, I will embark on a new quest, to have the same module with :
1. data sorted by date and a running total and cumulated percentage
2. being able to answer the question :
a. At what date will I reach Amount X ?
b. What cumulated percentage will a reach at date X ?
I will try to resolve this by myself,
if not, I will generate a new post titled "At what date will I reach
running total X ?
Thank you again,
J.P.