Summarize Data from Other Sheets Into A Single Sheet

drmingle

Board Regular
Joined
Oct 5, 2009
Messages
229
Objective:to pull summary details of selected spreadsheets and place the results on a new worksheet.

I have a userform that reads all the various worksheets in the workbook and applies pattern matching on the name, so as to only pull relevant worksheets for a user to select from.

The user can select a single worksheet or multi-worksheets.

Based on the selections made by the user I want to pull summary data from each sheet selected and place all of the results on a single worksheet.

I want to be able to ask the user if they would like to overwrite the tab with new results if worksheet tab already exists.

Summary Code:
Code:
Sub Create_SPAsummary()
'
' Create_PAsummary
'
'
Application.ScreenUpdating = False
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Select
    ActiveSheet.Name = "PA_Summary"
    Range("G9").Select
    Columns("A:A").ColumnWidth = 2.43
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Pricing Summary"
    Range("B4").Select
    Columns("B:B").EntireColumn.AutoFit
    Range("B2:B3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
    Range("B3").Select
    Selection.Font.Size = 16
    Columns("B:B").EntireColumn.AutoFit
    Range("B2").Select
    Selection.Font.Bold = True
    Range("B2:B3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("B2").Select
    Columns("B:B").ColumnWidth = 31.43
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "Facility Target Percentage"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "Facility Expected Net Revenue"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "ASC Expected Net Revenue"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "Other Expected Net Revenue Adj."
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "Total Expected Net Revenue"
    Range("B11").Select
    ActiveCell.FormulaR1C1 = "Proposed Pricing Net Revenue"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "Unallocated Net Revenue"
    Range("B6:B12").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.DisplayGridlines = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    Application.CutCopyMode = False
    Range("B4").Select
    
    Call Move_PApricing
    
Application.ScreenUpdating = True
End Sub

Code:
Sub Move_PApricing()
'
' 
'
'
Application.ScreenUpdating = False
    Sheets("SPA_Summary").Select
    Sheets("SPA_Summary").Move Before:=Sheets(17)
    Range("B4").Select
'color me as well
    Sheets("SPA_Summary").Select
    With ActiveWorkbook.Sheets("PA_Summary").Tab
        .Color = 5296274
        .TintAndShade = 0
    End With
    Range("B4").Select
Application.ScreenUpdating = True
End Sub


Userform Code:
Code:
Private Sub CommandButton1_Click()
Dim text As String
Dim i As Integer
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        text = text & Me.ListBox1.List(i) & vbNewLine
    End If
Next i
MsgBox "Items you selected: " & vbNewLine & text
GetSelectedItemsText = text

Unload Me
Call Create_PAsummary
Call Move_PApricing
Call Copy_Facility
End Sub

Code:
[Private Sub UserForm_Activate()
Dim i As Worksheet
    
    For Each i In ActiveWorkbook.Worksheets
        If i.Name Like "*Pricing[ ]#*" Then
            ListBox1.AddItem i.Name
        End If
    Next i
    
End Sub

Any help would be appreciated.

I am using Excel 2010.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
This is the first sub, which now includes a msgbox for the user to select if he wants to overwrite existing sheet

The rest of the sub I have rewritten a bit: there were a lot of unnecessary lines or duplicate lines

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> Create_SPAsummary()<br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">' Create_PAsummary</SPAN><br><SPAN style="color:#007F00">'</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> shSum <SPAN style="color:#00007F">As</SPAN> Worksheet, mbrReply <SPAN style="color:#00007F">As</SPAN> VbMsgBoxResult<br><SPAN style="color:#007F00">'</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> shSum = Sheets("PA_Summary")<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>    <SPAN style="color:#00007F">If</SPAN> shSum <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> shSum = Sheets.Add(After:=Sheets(Sheets.Count))<br>        shSum.Name = "PA_Summary"<br>    <SPAN style="color:#00007F">Else</SPAN><br>        mbrReply = MsgBox("Summary sheet exisits." & vbCr & vbCr & _<br>                        "Do you want to overwrite?", _<br>                        Buttons:=vbOKCancel, _<br>                        Title:="Summary Sheet")<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <br>    <SPAN style="color:#00007F">If</SPAN> mbrReply = vbCancel <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> shSum<br>        .Select<br>        <SPAN style="color:#00007F">With</SPAN> .Cells<br>            .HorizontalAlignment = xlRight<br>            .VerticalAlignment = xlBottom<br>            .WrapText = <SPAN style="color:#00007F">False</SPAN><br>            .MergeCells = <SPAN style="color:#00007F">False</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Font<br>                .Color = 0<br>                .Bold = <SPAN style="color:#00007F">False</SPAN><br>                .Underline = <SPAN style="color:#00007F">False</SPAN><br>                .Italic = <SPAN style="color:#00007F">False</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Interior<br>                .Pattern = xlSolid<br>                .Color = RGB(256, 256, 256)<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        .Columns("A:A").ColumnWidth = 2.43<br>        .Range("B2").Value = <SPAN style="color:#00007F">Date</SPAN>       <SPAN style="color:#007F00">' using this rather than formula</SPAN><br>                                        <SPAN style="color:#007F00">' puts the date in as text, so no</SPAN><br>                                        <SPAN style="color:#007F00">' need to copy paste as value later</SPAN><br>        .Range("B3").Value = "Pricing Summary"<br>        <br>        <SPAN style="color:#00007F">With</SPAN> .Range("B2:B3")            <SPAN style="color:#007F00">' you don't need to select cells in</SPAN><br>                                        <SPAN style="color:#007F00">' order to do something with them</SPAN><br>            .Borders(xlDiagonalDown).LineStyle = xlNone<br>            .Borders(xlDiagonalUp).LineStyle = xlNone<br>            <SPAN style="color:#00007F">With</SPAN> .Borders(xlEdgeLeft)<br>                .LineStyle = xlContinuous<br>                .ColorIndex = 0<br>                .TintAndShade = 0<br>                .Weight = xlMedium<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Borders(xlEdgeTop)<br>                .LineStyle = xlContinuous<br>                .ColorIndex = 0<br>                .TintAndShade = 0<br>                .Weight = xlMedium<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Borders(xlEdgeBottom)<br>                .LineStyle = xlContinuous<br>                .ColorIndex = 0<br>                .TintAndShade = 0<br>                .Weight = xlMedium<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Borders(xlEdgeRight)<br>                .LineStyle = xlContinuous<br>                .ColorIndex = 0<br>                .TintAndShade = 0<br>                .Weight = xlMedium<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            .Borders(xlInsideVertical).LineStyle = xlNone<br>            .Borders(xlInsideHorizontal).LineStyle = xlNone<br>                <br>            .HorizontalAlignment = xlCenter<br>            .VerticalAlignment = xlBottom<br>            .WrapText = <SPAN style="color:#00007F">False</SPAN><br>            .MergeCells = <SPAN style="color:#00007F">False</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Font<br>                .ThemeColor = xlThemeColorDark1<br>                .TintAndShade = 0<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> .Interior<br>                .Pattern = xlSolid<br>                .PatternColorIndex = xlAutomatic<br>                .ThemeColor = xlThemeColorAccent1<br>                .TintAndShade = -0.249977111117893<br>                .PatternTintAndShade = 0<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>   <SPAN style="color:#007F00">'.Range("B2:B3")</SPAN><br>        <br>        .Range("B3").Font.Size = 16<br>        .Range("B2").Font.Bold = <SPAN style="color:#00007F">True</SPAN><br>        .Range("B6").Value = "Facility Target Percentage"<br>        .Range("B7").Value = "Facility Expected Net Revenue"<br>        .Range("B8").Value = "ASC Expected Net Revenue"<br>        .Range("B9").Value = "Other Expected Net Revenue Adj."<br>        .Range("B10").Value = "Total Expected Net Revenue"<br>        .Range("B11").Value = "Proposed Pricing Net Revenue"<br>        .Range("B12").Value = "Unallocated Net Revenue"<br>        .Columns("B:B").EntireColumn.AutoFit<br>        <br>        ActiveWindow.DisplayGridlines = <SPAN style="color:#00007F">False</SPAN><br>        .Range("B4").Select<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>    <SPAN style="color:#007F00">'shSum</SPAN><br>    <br>    <SPAN style="color:#007F00">' Call Move_PApricing</SPAN><br>    <br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0
Do you have some typos? I am a bit confused with the sheet naming:
You have a sub Create_SPAsummary() which creates a sheet called PA_Summary

Then you have a sub called Move_PApricing() which moves a sheet called SPA_Summary
and recolours the tab of sheet PA_Summary

So which sheets are there? and time to rename some of your subs I guess.
 
Upvote 0
<font face=Courier New><br><br><SPAN style="color:#00007F">Sub</SPAN> Move_PApricing()    <SPAN style="color:#007F00">' wrong name??</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">'</SPAN><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Sheets("SPA_Summary").Move Before:=Sheets(17)<br>            <SPAN style="color:#007F00">' what is sheet(17)? is that perhaps the (new)</SPAN><br>            <SPAN style="color:#007F00">' sheet PA_Summary? It will get a different _<br>              number possibly next time</SPAN><br><SPAN style="color:#007F00">'color me as well _<br> this should really be done in Create_SPASummary()</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> ActiveWorkbook.Sheets("PA_Summary").Tab<br>        .Color = 5296274<br>        .TintAndShade = 0<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Range("B4").Select<br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top