Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 11
Default 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.


  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 35,218
Default 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
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 11
Default 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

  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 35,218
Default 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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I change sheet notation from R1C1 style to A1 style in XL 2 Sherlock1506 Setting up and Configuration of Excel 1 December 5th 06 03:22 PM
making copied cells change with change in original cell Jennifer Mcdermeit Excel Worksheet Functions 2 July 20th 06 04:58 PM
How do I retain a zero as the first number in a postal code? Laureen Excel Discussion (Misc queries) 7 February 28th 06 05:34 PM
How do I merge 2 cells to 1 when contents are numbers AND retain decimals huruta Excel Discussion (Misc queries) 3 January 28th 06 07:37 PM
How do I change the number format for decimals from , to .? Nicole Setting up and Configuration of Excel 2 December 13th 05 05:31 AM


All times are GMT +1. The time now is 11:11 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"