Change number of decimals but retain original style

[Alice Graham]

I have a number of custom styles, all numeric, but some have currency symbols
and some have characters after the numeric part.

I need to be able to select a range of cells which contain a mixture of
these custom number formats, and increase/decrease the number of decimal
places while retaining the old format.

The native increase/decrease decimals command applies the number format of
the first cell in the range to the entire range, so it is not suitable.

As an example, I would like an "increase decimal" to change:

£1.23
$6.97
4.557m

into

£1.233
$6.971
4.5572m

I would appreciate any help with this, Thanks.

 

[Dave Peterson]

And you really used Format|Style... to create these styles?

If yes, then this may work for you.

Option Explicit
Sub testme()

Dim StyleNamesToChange As Variant
Dim iCtr As Long
Dim WorkedOk As Boolean

StyleNamesToChange = Array("test1") ', "test2")

For iCtr = LBound(StyleNamesToChange) To UBound(StyleNamesToChange)

WorkedOk = ChangeNumberFormatInStyle(WhatWorkbook:=ActiveWorkbook, _
StyleName:=CStr(StyleNamesToChange(iCtr)), IncreaseDec:=True)

If WorkedOk = False Then
MsgBox StyleNamesToChange(iCtr) & " failed"
End If
Next iCtr
End Sub
Function ChangeNumberFormatInStyle(WhatWorkbook As Workbook, _
StyleName As String, IncreaseDec As Boolean) As Boolean

Dim TestStyle As Style
Dim OldNumberFormat As String
Dim NewNumberFormat As String
Dim cCtr As Long
Dim WorkedOk As Boolean

Set TestStyle = Nothing
On Error Resume Next
Set TestStyle = WhatWorkbook.Styles(StyleName)
On Error GoTo 0

WorkedOk = False
If TestStyle Is Nothing Then
'not used
Else
OldNumberFormat = TestStyle.NumberFormat
NewNumberFormat = ""
For cCtr = Len(OldNumberFormat) To 1 Step -1
If IncreaseDec = True Then
'look for a 0 or decimal point
If Mid(OldNumberFormat, cCtr, 1) = "0" _
Or Mid(OldNumberFormat, cCtr, 1) = "." Then
NewNumberFormat = Left(OldNumberFormat, cCtr) _
& "0" & Mid(OldNumberFormat, cCtr + 1)
'and stop looking
Exit For
Else
'keep looking
End If
Else
If Mid(OldNumberFormat, cCtr, 1) = "0" Then
'delete it
NewNumberFormat = Left(OldNumberFormat, cCtr - 1) _
& Mid(OldNumberFormat, cCtr + 1)
'and stop looking
Exit For
End If
End If
Next cCtr

If NewNumberFormat = "" Then
'last 0 wasn't found, do nothing
Else
On Error Resume Next
TestStyle.NumberFormat = NewNumberFormat
If Err.Number = 0 Then
WorkedOk = True
Else
Err.Clear
End If
On Error GoTo 0
End If
End If

ChangeNumberFormatInStyle = WorkedOk

End Function

There's not a lot of validation going on, so test it before you trust it.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

There are two parts to this--the sub is what starts it -- the sub calls the
function that does the work.

You'd change this line:

StyleNamesToChange = Array("test1", "test2")

To list the style names that you want to change.

In this line, the
WorkedOk = ChangeNumberFormatInStyle(WhatWorkbook:=ActiveWorkbook, _
StyleName:=CStr(StyleNamesToChange(iCtr)), IncreaseDec:=True)

True means to increment the number of decimal places.
False will decrement them.

 

[Alice Graham]

Thanks Dave,

The custom number format specifies how to display positive, negative and
zero number so I'll just need to tweak this a little around the "and stop
looking" line, but it's certainly working as is for zero numbers

One more question - you seem surprised that Format|Style has been used to
create these styes? Why is that?

 

[Dave Peterson]

I don't think many people take advantage of Styles. It's kind of a surprise
when anyone knows that they exist--much less use them.

If you're using xl2k or higher, maybe you could use split() to separate each
element in the numberformat. Then try to do insert/delete 0's to each of those
elements????