Solved/Closed
talkwutty Posts 2 Registration date Friday April 16, 2010 Status Member Last seen April 16, 2010 - Apr 16, 2010 at 11:58 AM
talkwutty Posts 2 Registration date Friday April 16, 2010 Status Member Last seen April 16, 2010 - Apr 16, 2010 at 07:52 PM
I've 4 columns and 10000 rows like this :

Month Plant Area Budget
Jan ........ A1 ........01 ........ 1000
Jan ........ A1 ........01........ 2000
Jan ........ A2 ........03........ 1500
Feb ....... A1 ........02........ 1100
Feb ....... A1 ........02........ 1300
.......etc
and I alway make report in each month each plant each area and sum the budget (in other sheet) such as

Month Jan Plant A1 Area 01 total budget is 3000
............Jan...........A2..........03....................1500
............Feb...........A1..........02....................2400

Related:

## 1 response

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 16, 2010 at 01:34 PM
Assumptions
1. Data is on Sheet1
2. Total is to be calculated on Sheet2, which exists

```Sub SummaryReport()
Dim lMaxRows As Long
Dim lMaxRows1 As Long
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row

With Range(Cells(1, "E"), Cells(lMaxRows, "E"))

.FormulaR1C1 = "=RC1 & ""|"" & RC2 & ""|"" & RC3"
.Copy
.PasteSpecial xlPasteValues
End With

Sheets("Sheet2").Range("A1:A" & lMaxRows) = Range(Cells(1, "E"), Cells(lMaxRows, "E")).Value

Sheets("Sheet2").Select

Columns("A:A").Select
Application.CutCopyMode = False
Columns("A:A").Select

Columns("A:A").Delete

lMaxRows1 = Cells(Rows.Count, "A").End(xlUp).Row
Range("D1") = "Monthy Total"
With Range(Cells(2, "D"), Cells(lMaxRows1, "D"))

.FormulaR1C1 = "=SUMIF(Sheet1!C5:C5,Sheet2!RC1,Sheet1!C4:C4)"
.Copy
.PasteSpecial xlPasteValues
End With

Columns("A:A").Select
Selection.TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

Sheets("Sheet1").Select
Range(Cells(1, "E"), Cells(lMaxRows, "E")).Clear

End Sub
```
talkwutty Posts 2 Registration date Friday April 16, 2010 Status Member Last seen April 16, 2010
Apr 16, 2010 at 07:52 PM
Thank a lot.