Please help macro or formula excel

[Solved/Closed]
Report
Posts
2
Registration date
Friday April 16, 2010
Status
Member
Last seen
April 16, 2010
-
Posts
2
Registration date
Friday April 16, 2010
Status
Member
Last seen
April 16, 2010
-
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

Please help me to write macro or formula about this case. Nowaday I use "filter command" and do it in each case. it's take much time to do this. thanks.

1 reply

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
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
    
    Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    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
Posts
2
Registration date
Friday April 16, 2010
Status
Member
Last seen
April 16, 2010

Thank a lot.