Excel VBA - add a custom number format

Question

I have a file, generated outside Excel with many percentages. All these percentages have a single decimal place. When imported into excel, Excel adds a second decimal place to the percentages - this seems to be some default format for percentages in Excel. It just adds a "0".

I want to format all double-decimal places percentages to a single decimal point. If I do this manually, by using CTRL+H, Find format/replace format, it goes well. But I cannot do this via VBA/macro, even if I record the macro while doing the replacement manually. The code generated by recording the macro is this:

Application.FindFormat.NumberFormat = "0.00%"
Application.ReplaceFormat.NumberFormat = "0.0%"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

The failure happens at:

Application.ReplaceFormat.NumberFormat = "0.0%"

After a lot of trial and error, I found that the new format needs to be in the Custom format list. But single-decimal place percentages is not there by default. If I manually format a single cell to the desired format, the macro works. Of course, I do not want to do that with every file.

Any input would be much appreciated.

Thanks in advance!

Answer 1

If you apply the custom number format to a single cell, it will become 'listed' and subsequently available for future use with a bulk replacement operation. I might recommend using something like,

 .range("A1").NumberFormat = "0.0%;@"

That particular format mask can be applied to any cell with a percentage or text. If you had a column header label with a text value and applied that CNF, the ;@ portion forces the text to be displayed literally (without change). In this manner you are open to more possibilities where you put the first CNF. After it has been used once, it will be available for bulk replacement operation(s) on the remainder of the percentage values.

Answer 2

Consider the simple:

Sub dural()
    Dim r As Range
    For Each r In ActiveSheet.UsedRange
        If r.NumberFormat = "0.00%" Then
            r.NumberFormat = "0.0%"
        End If
    Next r
End Sub