PDA

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



woody3737
03-17-2009, 11:40 AM
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
03-17-2009, 11:49 AM
I failed to mention that the header could also just contain POS Sales, such as "2008 POS Sales" & "2009 POS Sales"

mdmackillop
03-17-2009, 11:51 AM
Why not create a Style called POS. Easy then to create a change event that will apply that to the column.

woody3737
03-17-2009, 12:14 PM
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
03-17-2009, 01:14 PM
Here's a simple example

mdmackillop
03-17-2009, 01:18 PM
More generic. Type any style name in row 1

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

woody3737
03-18-2009, 12:24 PM
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
03-18-2009, 12:46 PM
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
03-18-2009, 02:25 PM
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
03-18-2009, 04:07 PM
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
03-19-2009, 02:18 PM
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
03-19-2009, 02:21 PM
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
03-19-2009, 04:09 PM
No problem. Your code can stand a little trimming though.

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

woody3737
03-23-2009, 06:25 AM
md, thanks for taking the time to clean up this code. It's working perfectly. I appreciate all of the help.