Increase / decrease decimal - retain cell formatting

[kbellendir]

Right now I'm using the following to create shortcuts to
increase/decrease decimals:

Sub increaseDecimal()
Application.CommandBars("formatting").FindControl(ID:=398).Execute
End Sub
Sub decreaseDecimal()
Application.CommandBars("formatting").FindControl(ID:=399).Execute
End Sub

Is there a way to set this up so that a selection of cells will retain
individual cell formats?

For example:

If I have the following selected:

12.935%
$13.4
#,##0.0_)

When I use this macro it will change all of the selected cells to
either a percentage, the dollar, or other custom formats.

Thank you.

 

[Guest]

You can return individual number formats in a string, minipulate it (add or
remove a "0"), then reassign it back to the cell.

Too many posibilities to code for free

Sub NumberFortmatChange()
Dim i As Integer
Dim rngCell As Range
Dim strNumFormatNew As String, strNumFormatOld As String
Dim varSplit As Variant

For Each rngCell In Selection
strNumFormatOld = rngCell.NumberFormat
If Left(strNumFormatOld, Len("General")) <> "General" Then
varSplit = Split(strNumFormatOld, ";")
For i = LBound(varSplit) To UBound(varSplit)
' here you can evaluate each section of the number format
' and add or delete a zero as needed
' +++++++++++++++++++++++++++++++
' there are 1,000s of possibilities
' +++++++++++++++++++++++++++++++
Next
For i = LBound(varSplit) To UBound(varSplit) - 1
' reassemble the updated number format
strNumFormatNew = varSplit(i) & ";"
Next
rngCell.NumberFormat = strNumFormatNew
End If
Next
End Sub

Hope it helps and good luck!

Dale Preuss

 

[Guest]

Opps, I missed something... try this

Sub NumberFortmatChange()
Dim i As Integer
Dim rngCell As Range
Dim strNumFormatNew As String, strNumFormatOld As String
Dim varSplit As Variant

For Each rngCell In Selection
strNumFormatOld = rngCell.NumberFormat
If Left(strNumFormatOld, Len("General")) <> "General" Then
varSplit = Split(strNumFormatOld, ";")
For i = LBound(varSplit) To UBound(varSplit)
MsgBox varSplit(i)
Next
For i = LBound(varSplit) To UBound(varSplit) - 1
'reassemble the updated number format
strNumFormatNew = strNumFormatNew & varSplit(i) & ";"
Next
strNumFormatNew = strNumFormatNew & varSplit(UBound(varSplit))
rngCell.NumberFormat = strNumFormatNew
End If
Next
End Sub

Dale Preuss Take II

 

[Dave Peterson]

Maybe do each cell individually:

Option Explicit
Sub testme22()

Dim actCell As Range
Dim myRng As Range
Dim myCell As Range

Set myRng = Selection
Set actCell = ActiveCell

For Each myCell In myRng.Cells
myCell.Select
Call increaseDecimal
Next myCell

myRng.Select
actCell.Activate

End Sub

Sub increaseDecimal()
Application.CommandBars("formatting").FindControl(ID:=398).Execute
End Sub
Sub decreaseDecimal()
Application.CommandBars("formatting").FindControl(ID:=399).Execute
End Sub