Please help macro or formula excel Solved/Closed

Question

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.  
Configuration: Windows XP / Internet Explorer 8.0

rizvisa1 · Answer

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

Please help macro or formula excel

1 response

Similar discussions

Subscribe To Our Newsletter!