I started learning about macros a few weeks ago, and currently I'm stuck with this challenge.
I would like to create a macro and then associate it to a shortcut that increases/ decreases the decimal by one to the cells I have selected, without changing the format of the cells in case they have different format between them.
What I want the macro to do is, for example:
If i have selected cells A1 and B1 that contain 10,0% and 1,0, respectively. By running the macro through a shortcut (for example "Ctrl + ,") the values of the cells to increase by one decimal point to 10,00% and 1,00.
I would also like that when using another shortcut (for example "Ctrl + .") to decrease the number of decimals of the selected cells, to 10% and 1.
I've only been able to increase/decrease the decimals, but the format of one of the cells changes to %, given that is the format of the first cell (A1).
In conclusion, I would like the macro to increase/decrease the decimal points without changing the format, no matter what it is.
I know I need to have 2 separate macros, one for increase decimals and one to decrease, but I haven't find any solution for my problem online.
Thanks in advanced.
My macro uses the CommandBars
command. Unfortunately, it works correctly only with US system settings (decimal point). If you are using other locale, you need to change it for a while. If you have the US settings, you can skip these changes.
Sub ChangeDec(action As Long)
' action = 13 => increase
' action = 14 => decrease
Dim cell As Range, sel As Range
Set sel = Selection
With Application
.ScreenUpdating = False
.DecimalSeparator = "."
.ThousandsSeparator = ","
.UseSystemSeparators = False
For Each cell In sel
cell.Select
.CommandBars("Formatting").Controls(action).Execute
Next cell
sel.Select
.UseSystemSeparators = True
.ScreenUpdating = True
End With
End Sub
Additional procedures for setting shortcut keys.
Sub Definekeys()
Application.OnKey "^,", "'ChangeDec 13'" ' apostrophes are needed
Application.OnKey "^.", "'ChangeDec 14'"
End Sub
Sub Undefinekeys()
Application.OnKey "^,"
Application.OnKey "^."
End Sub