Sub RequestNetSave()
Application.DisplayAlerts = False
Columns("K:K").Select
Columns("K:K").EntireColumn.AutoFit
'Dim OnlyOne
'OnlyOne = "MoreThanOne"
'Range("A2").Select
'
'If ActiveCell.Offset(1, 0).Value = "" Then
' OnlyOne = "One"
'End If
Dim ThePath
ThePath = ActiveWorkbook.Path
' previous code
' Range("A1").Select
' ActiveCell.SpecialCells(xlLastCell).Select
' ActiveCell.Offset(0, -5).Select
'
' 'Range("M25").Select
' Range(Selection, Cells(1)).Select
Range("A1").Select
Columns("A:A").Select
Selection.Find(What:="Report run on", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
Dim myAddress
myAddress = ActiveCell.Address
Range("A1").Select
Range(Selection, myAddress).Select
Range(Selection, Selection.Offset(0, 12)).Select
Dim currSelection As Range
Set currSelection = Application.Selection
Dim mySelection As String
mySelection = currSelection.Address
[COLOR=#B22222] With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
ThePath & "\SR_Hit_List.htm" _
, "Completed file", mySelection, xlHtmlStatic, "GetWgAssignStatus_25614", _
"")
.Publish (True)
.AutoRepublish = False
End With[/COLOR]
[COLOR=#B22222] [/COLOR]
' , "Completed file", "$A$2:$M$25", xlHtmlStatic, "OSP FOC 2012 02 10 pm_25614", _
' end save as web page
Dim DtToday As String
Dim MyDate
MyDate = Date
Dim TheYear
Dim TheMonth
Dim TheMonthStr
Dim TheDay
Dim TheDayStr
TheYear = DatePart("yyyy", MyDate)
TheMonth = DatePart("m", MyDate)
TheDay = DatePart("d", MyDate)
TheMonthStr = Trim(Str(TheMonth))
TheDayStr = Trim(Str(TheDay))
If TheMonth < 10 Then TheMonthStr = "0" & TheMonthStr
If TheDay < 10 Then TheDayStr = "0" & TheDayStr
DtToday = TheYear & " " & TheMonthStr & " " & TheDayStr
Dim CompleteSavedFileName
' Dim UserMonthTextInput
'ThePath = ActiveWorkbook.Path
' UserMonthTextInput = InputBox("Enter the month in text form to start building the file name")
Dim myTimeForFilename
UserForm1.Show
With UserForm1
myTimeForFilename = UserForm1.ListBox1.Value
End With
Unload UserForm1
CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & ".xls"
If myTimeForFilename = "Noon" Then
CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & " Noon.xls"
End If
If myTimeForFilename = "PM" Then
CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & " pm.xls"
End If
ActiveWorkbook.SaveAs fileName:=CompleteSavedFileName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Range("A1").Select
Columns("A:A").Select
Selection.Find(What:="Report run on", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
ActiveCell.Offset(-4).Select
myAddress = ActiveCell.Address
Range("A1").Select
Range(Selection, myAddress).Select
Range(Selection, Selection.Offset(0, 12)).Select
' previous code
' Range("A1").Select
' ActiveCell.SpecialCells(xlLastCell).Select
' ActiveCell.Offset(-4, -10).Select
' 'Range("M25").Select
' ' PROBLEM? 1/20/2014
' Range(Selection, Cells(1)).Select
Dim currSelection2 As Range
Set currSelection2 = Application.Selection
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
currSelection2, Version:=xlPivotTableVersion12). _
CreatePivotTable TableDestination:="Sheet3!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion12
' ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
' currSelection2, Version:=xlPivotTableVersion12). _
' CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
' , DefaultVersion:=xlPivotTableVersion12
Sheets("Sheet3").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OSP Target")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("SR-ID"), "Count of SR-ID", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Group Name")
.Orientation = xlColumnField
.Position = 1
End With
ActiveWorkbook.ShowPivotTableFieldList = False
Range("B7").Select
ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"
Range("B4").Select
'Problem Here ? ==============================
' If OnlyOne = "MoreThanOne" Then
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OSP Target")
.PivotItems("(blank)").Visible = False
End With
' End If
'==============================================
Range("B4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Font
.Name = "Calibri"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Rows("4:4").Select
Selection.RowHeight = 52.5
Columns("B:B").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("B:N").Select
Selection.ColumnWidth = 12.57
Range("A1").Select
RequestNetSave2
Application.DisplayAlerts = True
MsgBox ("Macro Complete")
End Sub
Sub RequestNetSave2()
Sheets("Completed file").Select
Range("A2").Select
Sheets("Sheet3").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "[$-409]m/d/yyyy h:mm AM/PM;@"
Dim DtToday As String
Dim MyDate
MyDate = Date
Dim TheYear
Dim TheMonth
Dim TheMonthStr
Dim TheDay
Dim TheDayStr
TheYear = DatePart("yyyy", MyDate)
TheMonth = DatePart("m", MyDate)
TheDay = DatePart("d", MyDate)
TheMonthStr = Trim(Str(TheMonth))
TheDayStr = Trim(Str(TheDay))
If TheMonth < 10 Then TheMonthStr = "0" & TheMonthStr
If TheDay < 10 Then TheDayStr = "0" & TheDayStr
DtToday = TheYear & "_" & TheMonthStr & "_" & TheDayStr
Dim myPath
myPath = ActiveWorkbook.Path
ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
With ActiveWorkbook.PublishObjects.Add(xlSourcePivotTable, _
myPath & "\SR_Hit_List_Pivot.htm" _
, "Sheet3", "PivotTable1", xlHtmlStatic, "OSP FOC " & DtToday & "_17222", "")
.Publish (True)
.AutoRepublish = False
End With
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Pivot"
Range("A1").Select
ActiveWorkbook.save
End Sub