Change number of decimals but retain original style
 

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.

Change number of decimals but retain original style
 

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:=ActiveWork book, _
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:=ActiveWork book, _
StyleName:=CStr(StyleNamesToChange(iCtr)), IncreaseDec:=True)

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





Alice Graham wrote:

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

Change number of decimals but retain original style
 

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" wrote:

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:=ActiveWork book, _
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:=ActiveWork book, _
StyleName:=CStr(StyleNamesToChange(iCtr)), IncreaseDec:=True)

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





Alice Graham wrote:

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

Change number of decimals but retain original style
 

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????

Alice Graham wrote:

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" wrote:

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:=ActiveWork book, _
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:=ActiveWork book, _
StyleName:=CStr(StyleNamesToChange(iCtr)), IncreaseDec:=True)

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





Alice Graham wrote:

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


--

Dave Peterson