Rhonda,
Here's an attempt to allow you or anyone else to adapt this with minimal editing of the VBA code.
To do that, I'd suggest the use of a three-column range within your workbook to define any special formatting.
This is loosely based on your list; however I've modified it a bit to show Delete and Color.
In this example, the range is on Sheet "Drill Down" which could be a hidden sheet if you prefer.
Sheet Drill Down
*
| A
| B
| C
|
1
| Data Source Header
| Property or Method
| Value
|
2
| Letting Date
| Hidden
| TRUE
|
3
| Designer
| *
| *
|
4
| Office
| Hidden
| TRUE
|
5
| Contractor
| Hidden
| TRUE
|
6
| Project Awarded Amount
| NumberFormat
| "$#,##0.00"
|
7
| Project Authorized Amount
| Delete
| *
|
8
| Awarded Quantity
| NumberFormat
| "0.000"
|
9
| Awarded Quantity
| Color
| 10092543
|
10
| From Quantity
| Hidden
| TRUE
|
<TBODY>
</TBODY>
Excel tables to the web >> Excel Jeanie HTML 4
The order of the fields on the list doesn't matter and you don't need to list the fields that do not need special formatting (like "Designer").
You could list all your fields if it helps you- the code will make no change to a field if its second column is blank.
The only other setup needed is to replace function Format_PT_Detail with this version,
and paste the function Format_Table shown below into the same Standard Module as Format_PT_Detail.
Rich (BB code):
Public Function Format_PT_Detail(tblNew As ListObject)
'---Called by Workbook_NewSheet; Passes ShowDetai table object
'---Uses Pivot Table's SourceData Property stored in Public sSourceDataR1C1
'--- to read apply NumberFormats in first row of SourceData to tblNew
Dim cSourceTopLeft As Range
Dim lCol As Long
Dim sSourceDataA1 As String
If sSourceDataR1C1 = vbNullString Then Exit Function
sSourceDataA1 = Application.ConvertFormula(sSourceDataR1C1, _
xlR1C1, xlA1)
Set cSourceTopLeft = Range(sSourceDataA1).Cells(1)
With tblNew
For lCol = 1 To .Range.Columns.Count
.ListColumns(lCol).Range.NumberFormat = _
cSourceTopLeft(2, lCol).NumberFormat
Next lCol
'Optional to do additional formatting
Call Format_Table(tbl:=tblNew, _
rFieldFormats:=Sheets("Drill Down").Range("A1").CurrentRegion)
tblNew.Unlist 'Optional: Converts Table to Standard Range
.Cells(1).Select
End With
sSourceDataR1C1 = vbNullString
cSourceTopLeft = Nothing
End Function
Rich (BB code):
Private Function Format_Table(tbl As ListObject, rFieldFormats As Range)
'---Uses the information in rFieldFormats to format the Table
' 3 columns in rFieldFormats define: Field | Property | New Property Value
' Example Net Sales | NumberFormat | "$#,##0.00"
Dim c As Range
Dim sField As String, sFieldRef As String
Dim sProperty As String, sNewValue As String
On Error Resume Next
For Each c In rFieldFormats.Resize(, 1)
sField = c(1, 1)
sProperty = c(1, 2)
sNewValue = c(1, 3)
sNewValue = Replace(sNewValue, """", "") 'remove any quotes
sFieldRef = tbl.Name & "[" & sField & "]"
With Range(sFieldRef)
Select Case sProperty
Case "Color"
.Interior.Color = sNewValue
Case "Delete"
.EntireColumn.Delete
Case "Font"
.Font = sNewValue
Case "Hidden"
.EntireColumn.Hidden = sNewValue
Case "NumberFormat"
.NumberFormat = sNewValue
Case ""
'---No formatting changes
Case "Property or Method"
'---Skip rFieldFormats Header Row
Case Else
MsgBox sProperty & " is not a defined Property " & _
"or Method in Function Format_Table"
End Select
End With
Next c
Set c = Nothing
End Function
These two functions are unchanged and should be pasted where noted in in Post #2 of this thread.
Workbook_NewSheet
Worksheet_BeforeDoubleClick
Please let me know if this does what you wanted, or if you want any help adapting it for your use.
