Bluebeam CSV to Formatted Pivot VIA excel
Attribute VB_Name = "BuildSummaryFromBluebeam"
Option Explicit
Option Compare Text
Sub Bluebeam_CSV_Build_Summary()
Attribute Bluebeam_CSV_Build_Summary.VB_Description = "Take CSV from bluebeam and build table, apply formatting, create pivot, format pivot"
Attribute Bluebeam_CSV_Build_Summary.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Bluebeam_CSV_Build_Summary Macro
' Take CSV from bluebeam and build table, apply formatting, create pivot, format pivot
'
'
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rowMax As Long
Dim colMax As Long
Dim i As Long
Dim j As Long
Dim pvtCache As PivotCache
Dim pvtTable As PivotTable
Dim pf As PivotField ''iterate fields in pivot
Dim tbl As ListObject
Dim fso As New FileSystemObject
Dim wbName As Variant
Set ws = ActiveSheet
With ActiveWorkbook ''Save=as XLSM
.SaveAs Filename:=GetBaseFN(.name, 4), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With
colMax = ws.Cells(1, Columns.count).End(xlToLeft).Column '''assume regular headers not gaps on 1st row
j = 0
For i = 1 To colMax
j = ws.Cells(ws.Rows.count, i).End(xlUp).Row
If rowMax < j Then rowMax = j
Next i
Application.CutCopyMode = False
Set tbl = ws.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(rowMax, colMax)), , xlYes)
tbl.name = CleanTableName(Application.ActiveWorkbook.name)
tbl.TableStyle = "TableStyleMedium2"
Application.CutCopyMode = False
Set ws2 = Sheets.Add
ws2.name = Left(tbl.name, 16)
' Create the PivotCache
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbl.name, Version:=xlPivotTableVersion15)
' Create the PivotTable and set the reference to pvtTable
Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=ws2.name & "!R3C1", TableName:="PivotTable1")
ws2.Select
Cells(3, 1).Select
With pvtTable
.ColumnGrand = False
.HasAutoFormat = False
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = False
.SaveData = False
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
With .PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
.RepeatAllLabels xlRepeatLabels
For i = 1 To tbl.ListColumns.count ''for each column in source data
With .PivotFields(tbl.ListColumns(i).name)
.Orientation = xlRowField
.Position = i
End With
Next i
'With .PivotFields("Page Index")
' .Orientation = xlRowField
' .Position = 1
'End With
'With .PivotFields("Page Label")
' .Orientation = xlRowField
' .Position = 2
'End With
'With .PivotFields("Creation Date")
' .Orientation = xlRowField
' .Position = 3
'End With
For Each pf In .PivotFields
If pf.name Like "Hours*" _
Or pf.name Like "Minutes*" _
Or pf.name Like "Seconds*" _
Then
pf.Orientation = xlHidden ''hide overkill fields
End If
Next pf
For Each pf In .PivotFields
If pf.name Like "*Date*" _
And Not ( _
pf.name Like "Hours*" _
Or pf.name Like "Minutes*" _
Or pf.name Like "Seconds*" _
) _
Then
pf.NumberFormat = """Time Index: ""yyyy-mm-dd""T""hh:mm:ss;@"
'pf.AutoGroup
End If
If pf.name Like "*Page Index*" Then
pf.NumberFormat = """Page Index"" ##"
'pf.AutoGroup
End If
If pf.name Like "*Page Label*" Then
pf.NumberFormat = """Page Label"" ##"
'pf.AutoGroup
End If
Next pf
'.PivotFields("Creation Date").AutoGroup
'.PivotFields("Hours (Creation Date)"). _
' Orientation = xlHidden
'.PivotFields("Minutes (Creation Date)"). _
' Orientation = xlHidden
'.PivotFields("Seconds (Creation Date)"). _
' Orientation = xlHidden
'With .PivotFields("Subject")
' .Orientation = xlRowField
' .Position = 4
'End With
'With .PivotFields("Subject")
' .Orientation = xlRowField
' .Position = 1
'End With
'With .PivotFields("Comments")
' .Orientation = xlRowField
' .Position = 5
'End With
'Range("A5").Select
'Selection.NumberFormat = """Page Index #"" ##"
'Application.Run "PERSONAL.XLSB!ApplyRowLabelFormatting_ActiveCell"
'Range("A6").Select
'Selection.NumberFormat = """Page Label #"" ##"
'Application.Run "PERSONAL.XLSB!ApplyRowLabelFormatting_ActiveCell"
'Range("A7").Select
'Selection.NumberFormat = """Time Index"" yyyy-mm-dd T hh:mm:ss"
''Application.Run "PERSONAL.XLSB!ApplyRowLabelFormatting_ActiveCell"
'.TableStyle2 = "PivotStyleMedium4 2"
'ActiveWindow.Zoom = 85
'ActiveWindow.Zoom = 70
'Columns("A:A").ColumnWidth = 57
'Columns("A:A").Select
With Columns("A:A")
.ColumnWidth = 57
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
''Set graphic style
.TableStyle2 = PivotTableStyle_Create_PivotStyleMedium4_2()
End With
End Sub
Function CleanTableName(name As String) As String
Dim regex As New RegExp ''Object
Dim cleanedName As String
' Create a regular expression object
Set regex = CreateObject("VBScript.RegExp")
' Define the pattern to match illegal characters and spaces
regex.Pattern = "[^\w]"
regex.Global = True
' Replace all illegal characters and spaces with underscores
cleanedName = regex.Replace(name, "_")
' Truncate to a maximum length of 255 characters
If Len(cleanedName) > 255 Then
cleanedName = Left(cleanedName, 255)
End If
' Return the cleaned table name
CleanTableName = cleanedName
End Function
Function GetBaseFN(strFN As String, Optional MaxLen As Integer = 4) As String
Dim Tmp As Variant ''variant to hold split array & Last value
On Error Resume Next ''if something errors out let it fall to next line
Tmp = Split(strFN, ".") ''Break at '.'
Tmp = Tmp(UBound(Tmp)) ''take last element- if no '.' found returns whole line
If Tmp > "" And Len(Tmp) <> Len(strFN) And Len(Tmp) <= MaxLen Then ''Last element isn't null and is less than mac length
GetBaseFN = Left(strFN, Len(strFN) - Len(Tmp) - 1) ''remove tmp and dot
Else
GetBaseFN = strFN ''Otherwise return full name
End If
On Error GoTo 0 ''Resume normal error checking
End Function
Function PivotTableStyle_Create_PivotStyleMedium4_2() As TableStyle
Attribute PivotTableStyle_Create_PivotStyleMedium4_2.VB_ProcData.VB_Invoke_Func = " \n14"
Dim PsStyle As TableStyle
'
On Error Resume Next ''Check if style exists
Set PsStyle = ActiveWorkbook.TableStyles("PivotStyleMedium4#2")
On Error GoTo 0
If PsStyle Is Nothing Then ''If not create it form existing OOTB style
Set PsStyle = ActiveWorkbook.TableStyles("PivotStyleMedium4").Duplicate("PivotStyleMedium4#2")
End If
With PsStyle
.ShowAsAvailablePivotTableStyle = True
.ShowAsAvailableTableStyle = False
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
.TableStyleElements(xlWholeTable).Clear
With .TableStyleElements(xlWholeTable).Font
.TintAndShade = 0
.ThemeColor = xlThemeColorLight1
End With
With .TableStyleElements(xlWholeTable).Borders(xlInsideHorizontal)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlHeaderRow).Clear
With .TableStyleElements(xlHeaderRow).Font
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With .TableStyleElements(xlHeaderRow).Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.PatternTintAndShade = -0.249977111117893
End With
With .TableStyleElements(xlHeaderRow).Borders(xlInsideHorizontal)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlTotalRow).Clear
With .TableStyleElements(xlTotalRow).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorLight1
End With
With .TableStyleElements(xlTotalRow).Borders(xlEdgeTop)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThick
.LineStyle = 9
End With
.TableStyleElements(xlRowStripe1).Clear
With .TableStyleElements(xlRowStripe1).Borders(xlEdgeTop)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlRowStripe1).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlRowStripe1).Borders(xlInsideHorizontal)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlColumnStripe1).Clear
With .TableStyleElements(xlColumnStripe1).Borders(xlEdgeLeft)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlColumnStripe1).Borders(xlEdgeRight)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlFirstHeaderCell).Clear
With .TableStyleElements(xlFirstHeaderCell).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
.TableStyleElements(xlSubtotalRow1).Clear
With .TableStyleElements(xlSubtotalRow1).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With .TableStyleElements(xlSubtotalRow1).Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0.399975585192419
End With
.TableStyleElements(xlSubtotalRow2).Clear
With .TableStyleElements(xlSubtotalRow2).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorLight1
End With
With .TableStyleElements(xlSubtotalRow2).Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorDark1
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = -0.149998474074526
End With
.TableStyleElements(xlColumnSubheading1).Clear
With .TableStyleElements(xlColumnSubheading1).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlRowSubheading1).Clear
With .TableStyleElements(xlRowSubheading1).Font
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With .TableStyleElements(xlRowSubheading1).Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249946592608417
.PatternTintAndShade = 0.399945066682943
End With
With .TableStyleElements(xlRowSubheading1).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlRowSubheading1).Borders(xlInsideHorizontal)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399975585192419
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlRowSubheading2).Clear
With .TableStyleElements(xlRowSubheading2).Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
.PatternTintAndShade = 0.799951170384838
End With
With .TableStyleElements(xlRowSubheading2).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlRowSubheading3).Interior
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
End With
.TableStyleElements(xlPageFieldLabels).Clear
With .TableStyleElements(xlPageFieldLabels).Borders(xlEdgeTop)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlPageFieldLabels).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
.TableStyleElements(xlPageFieldValues).Clear
With .TableStyleElements(xlPageFieldValues).Borders(xlEdgeTop)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
With .TableStyleElements(xlPageFieldValues).Borders(xlEdgeBottom)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.Weight = xlThin
.LineStyle = xlNone
End With
End With
Set PivotTableStyle_Create_PivotStyleMedium4_2 = PsStyle
End Function
Comments
Post a Comment