Help - need to consolidate worksheets to master - each providing one column of data

[ellgal]

I have a Master Forecast Report (MFR) in which each resulting column comes from various worksheets in the workbook. The MFR has the following columns that require population from the other worksheets:

A: Client Name
B: Billed
C: Potential New Revenue (PNR)
D: PNR Probability
E: Forecast
F: Budget

Worksheets feeding the MFR:

Column A in every worksheet is Client Name.

I have a "Billed" worksheet containing columns:
A: Client Name
B: Billed

I have a "PNR" worksheet containing columns:
A: Client Name
B: Potential New Revenue (PNR)
C: PNR Probability

I have a "Forecast" worksheet containing the columns:
A: Client Name
B: Forecast

I have a "Budget" worksheet containing the columns:
A: Client Name
B: Budget

• We need to bring every Client row from each worksheet into the MFR and then Sort by Client Name and then subtotal by Client.
• The number of rows in each worksheet varies from month to month
• We are currently doing the following, for the most part manually or with some referencing:

Copy columns A and B from "BILLED" to columns A and B of MFR
Copy columns A,B and C from "PNR" to columns A, C and D of MFR (please note - we copy each consecutive worksheet underneath the preceding
Copy columns A and B from "Forecast" to columns A and G of MFR
Copy columns A and B from "Budge" to column A and I of MFR
Sort by Client
Subtotal by Client
Create a summary roll up in a "SUMMARY" worksheet that contains the subtotals for the region

Would LOVE to be able to automate this with VB but don't have the know how....

 

[lzcrss2]

Hi there! You don't need VB to do this.

Step 1: In "MFR", column A: Client Name, list all of the Client names and sort them in Alphabetical Order.

Step 2: This assumes all of the metrics are able to be summed. In "MFR", the first client name is in cell A2. In cell B2 (which we want to be the first client name's Billed number), type in =SUMIF(Billed!$A:$A,$A2,Billed!$B:$B), then drag down for all the client names. In cell C2 (which we want to be the first client's PNR), type in =SUMIF(PNR!$A:$A,$A2,PNR!$B:$B), then in cell D2, type in =SUMIF(PNR!$A:$A,$A2,PNR!$C:$C). Then drag down for all the client names. Hopefully you start to get the idea, and you can figure out how do the exact same for Forecast and Budget.

As for the region subtotals, I'm not sure how you currently do that. But you could just insert a row at the top of all the client names and call it "Total" and sum everything below that for each column.

Let me know if this works!

Liz

 

[ellgal]

Hi there! You don't need VB to do this.

Step 1: In "MFR", column A: Client Name, list all of the Client names and sort them in Alphabetical Order.

Step 2: This assumes all of the metrics are able to be summed. In "MFR", the first client name is in cell A2. In cell B2 (which we want to be the first client name's Billed number), type in =SUMIF(Billed!$A:$A,$A2,Billed!$B:$B), then drag down for all the client names. In cell C2 (which we want to be the first client's PNR), type in =SUMIF(PNR!$A:$A,$A2,PNR!$B:$B), then in cell D2, type in =SUMIF(PNR!$A:$A,$A2,PNR!$C:$C). Then drag down for all the client names. Hopefully you start to get the idea, and you can figure out how do the exact same for Forecast and Budget.

As for the region subtotals, I'm not sure how you currently do that. But you could just insert a row at the top of all the client names and call it "Total" and sum everything below that for each column.

Let me know if this works!

Thank you Liz. I'm not sure this will work. For example, in "Billed" I may have 10 rows with the same Client name. Will that affect this solution? And, every week it's a new set of worksheets - very time consuming

 

[Fluff]

Here's as macro for you.
It assumes that the MFR sheet exists & wipes any data (excepting the headers), before adding the new data.

Sub MFR()

    Dim MFRSht As Worksheet
    Dim NxtRw As Long
    
Application.ScreenUpdating = False

    Set MFRSht = Sheets("MFR")
    With MFRSht
        With .Range("A2:F" & .Range("A" & Rows.Count).End(xlUp).Row)
        If .Rows.Count > 2 Then .Clear
        End With
    End With
    With Sheets("BILLED")
        .Range("A2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Copy MFRSht.Range("A2")
    End With
    With Sheets("PNR")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2:C" & .Range("B" & Rows.Count).End(xlUp).Row).Copy MFRSht.Range("C" & NxtRw)
    End With
    With Sheets("Forecast")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Copy MFRSht.Range("E" & NxtRw)
    End With
    With Sheets("Budget")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Copy MFRSht.Range("F" & NxtRw)
    End With
    
    With MFRSht
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1").CurrentRegion
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
End Sub

As I've no idea what your formulae are, or where you want them, I haven't done that part.

 

[ellgal]

Thank you Fluff - I will try this as well as Liz's approach and see what results. I will keep you posted!

 

[lzcrss2]

Thank you Fluff - I will try this as well as Liz's approach and see what results. I will keep you posted!

Yes it will work for the same client name being in multiple rows!!

 

[ellgal]

Wait - that got messed up

 

[ellgal]

Here's the formulas and final output
A: Client Name
B: Billed
C: PNR
D: PNR Probability
E: FORMULA: C * D
F: FORMULA: B + E
G: FORECAST
H: FORMULA: F - G
I: BUDGET
J: FORMULA: SUBTOTAL F - SUBTOTAL I

 

[Fluff]

Ok this will put the formulae in as well, with the exception of Col J, as I don't know which subtotal you're using

Sub MFR()

    Dim MFRSht As Worksheet
    Dim NxtRw As Long
    
Application.ScreenUpdating = False

    Set MFRSht = Sheets("MFR")
    With MFRSht
        With .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row)
        If .Rows.Count > 2 Then .Clear
        End With
    End With
    With Sheets("BILLED")
        .Range("A2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Copy MFRSht.Range("A2")
    End With
    With Sheets("PNR")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2:C" & .Range("B" & Rows.Count).End(xlUp).Row).Copy MFRSht.Range("C" & NxtRw)
    End With
    With Sheets("Forecast")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Copy MFRSht.Range("G" & NxtRw)
    End With
    With Sheets("Budget")
        NxtRw = MFRSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy MFRSht.Range("A" & NxtRw)
        .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Copy MFRSht.Range("I" & NxtRw)
    End With
    
    With MFRSht
        NxtRw = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("E2:E" & NxtRw).Formula = "=C2*D2"
        .Range("F2:F" & NxtRw).Formula = "=B2+E2"
        .Range("H2:H" & NxtRw).Formula = "=F2-G2"
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1").CurrentRegion
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
End Sub