Solved: [Excel 2007] Apply custom number format based on column header

[woody3737]

I have 4 different custom number formats that I use for various columns of data, one for currency, number, retail price, and percentage. I was wondering what the code might look like to have a macro search the column headers, in row 3, and based on what the column header is, it will apply a certain format, either to the entire column or just to the cells containing data. Either way would be ok. For example, if a column header is POS Sales, I would like it to apply the following format to the column:

 
"$#,##0_);[Red]($#,##0)"

I believe I'd be able to alter any suggested code to take into consideration all of the other header names. Thanks for any help.

[woody3737]

I failed to mention that the header could also just contain POS Sales, such as "2008 POS Sales" & "2009 POS Sales"

[mdmackillop]

Why not create a Style called POS. Easy then to create a change event that will apply that to the column.

[woody3737]

Thanks for the reply. Your suggestion is a little beyond me right now, but I'll do some research and see what I can come up with. Thanks again.

[mdmackillop]

Here's a simple example

[mdmackillop]

More generic. Type any style name in row 1
[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim st
If Target.Row = 1 Then
For Each st In ActiveWorkbook.Styles
If InStr(1, Target, st) > 0 Then
Target.EntireColumn.Style = st
Exit For
End If
Next
End If
End Sub

[/VBA]

[woody3737]

Would this work if the columns aren't always in the same location? For example, POS Sales might be in column B in one table but in column E in the next. I have a couple of dozen column headers I was hoping to set this up for and none of them are consistently in the same location from one tabel to the next. I wasn't sure how to have it search row 3, column by column, and apply a format based on the header.

[mdmackillop]

The code looks at the value you enter in Row 1 (or any other row) of any column, and if it contains a "valid" stye name, will format that column accordingly. With a little more work, it can format only numeric or text values, or omit certain predefined rows.

[woody3737]

I am not technically entering information into the row since it is being populated by a pivot table. Will this method work in this case? Also, I didn't see in either set of code where the actual formatting was established. Could you elaborate a little on this or point me towards what you would consider a good reference? Thanks again.

[mdmackillop]

The code makes use of "Styles" which includes all the formatting of a cell; Font/Bold/Border Colour etc. A macro can chech each header and apply a style to each column. Can you post a copy of your pivot table output with typical formats?

[woody3737]

In case anyone would like to use some code similar to this, here is an example of the solution I ended up with, thanks to others smarter than I.

 
Sub CustomNumberFormat()
 
Dim Cell, rngX As Range
Dim strFormat As String
Dim intCol As Integer
 
Set rngX = Range("B3:Z3")
strSlsFormat = "$#,##0_);[Red]($#,##0)"
strNbrFormat = "#,##0_);[Red](#,##0)"
strPerFormat = "#,##0.0%_);[Red](#,##0.0%)"
strPriFormat = "$#,##0.00_);[Red]($#,##0.00)"
 
Application.ScreenUpdating = False
 
For Each Cell In rngX
    Cell.Activate
    Select Case True
        Case (ActiveCell.Value Like "*Sales*")
            intCol = ActiveCell.Column
            With Columns(intCol)
                .NumberFormat = strSlsFormat
            End With
        Case (ActiveCell.Value Like "*Qty*")
            intCol = ActiveCell.Column
            With Columns(intCol)
                .NumberFormat = strNbrFormat
            End With
        Case (ActiveCell.Value Like "*%*")
            intCol = ActiveCell.Column
            With Columns(intCol)
                .NumberFormat = strPerFormat
            End With
        Case (ActiveCell.Value Like "*Retail*")
            intCol = ActiveCell.Column
            With Columns(intCol)
                .NumberFormat = strPriFormat
            End With
                
        Case Else
            
    End Select
Next Cell
 
Range("A3").Select
    
Application.ScreenUpdating = True
    
End Sub

[woody3737]

Also, sorry md for not getting back to you on your suggestion. I came across an early version of this code this morning and have been messing with it ever since. Thanks though for the help.

[mdmackillop]

No problem. Your code can stand a little trimming though.
[VBA]
Option Compare Text
Sub CustomNumberFormat()

Dim Cell As Range, rngX As Range
Dim strFormat As String

Set rngX = Range("B3:Z3")
strSlsFormat = "$#,##0_);[Red]($#,##0)"
strNbrFormat = "#,##0_);[Red](#,##0)"
strPerFormat = "#,##0.0%_);[Red](#,##0.0%)"
strPriFormat = "$#,##0.00_);[Red]($#,##0.00)"

Application.ScreenUpdating = False

For Each Cell In rngX
With Cell
Select Case True
Case .Value Like "*Sales*"
.EntireColumn.NumberFormat = strSlsFormat
Case .Value Like "*Qty*"
.EntireColumn.NumberFormat = strNbrFormat
Case .Value Like "*%*"
.EntireColumn.NumberFormat = strPerFormat
Case .Value Like "*Retail*"
.EntireColumn.NumberFormat = strPriFormat
End Select
End With
Next Cell

Application.ScreenUpdating = True

End Sub

[/VBA]

[woody3737]

md, thanks for taking the time to clean up this code. It's working perfectly. I appreciate all of the help.