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:
Userform Code:
Any help would be appreciated.
I am using Excel 2010.
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 SubUserform 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 SubAny help would be appreciated.
I am using Excel 2010.
