VBA for replacing format but preserving cell value

Question

I am trying to put together VBA to search for a specific cell format and then change that cell format. I got inspiration from this post (Excel VBA value remains string format after replacment) and hoped to get more from this post (Excel VBA - add a custom number format) but couldn't quite do it.

The cell formats I am wanting to replace are formatted general in the following 6 varieties:

1. < 0
2. < 0.1
3. < 0.01
4. < 0.001
5. < 0.0001
6. < 0.00001

I want to replace them with proper number formatting ("< 0", "< 0.0", etc.) and the remove the text symbol "<" so that they display as "< 0" but are stored as a number for use in calculations.

My approach so far has been the VBA Replace function. For a given range, I have been trying to run 6 different replacements for the 6 different formats and then remove all text symbols for "<", but I am stuck on replacing the cell value with its own value: currently all cells are replaced with the same value (the value of the first cell in the range).

The code I have developed so far is:

Private Sub CommandButton6_Click()

Dim range1 As Range

With ActiveWorkbook.Worksheets("Sheet1")
    Set range1 = .[B2:B7]
End With

For Each cell In range1.Cells
    Dim Original0value As String
    Original0value = cell.Value
    Application.findformat.NumberFormat = "General"
    Application.ReplaceFormat.NumberFormat = "< 0"
    With range1
        .Replace What:="< ?", Replacement:=Original0value, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchFormat:=True, ReplaceFormat:=True
    End With
Next cell

For Each cell In range1.Cells
    Dim Original1value As String
    Original1value = cell.Value
    Application.findformat.NumberFormat = "General"
    Application.ReplaceFormat.NumberFormat = "< 0.0"
    With range1
        .Replace What:="< ???", Replacement:=Original1value, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchFormat:=True, ReplaceFormat:=True
    End With
Next cell

For Each cell In range1.Cells
    Dim Original2value As String
    Original2value = cell.Value
    Application.findformat.NumberFormat = "General"
    Application.ReplaceFormat.NumberFormat = "< 0.00"
    With range1
        .Replace What:="< ????", Replacement:=Original2value, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchFormat:=True, ReplaceFormat:=True
    End With
Next cell

' et cetera - I have only include the first 3 blocks of a possible 6

    Cells.Replace What:="<", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

This gives me the result:

1. < 0
2. < 0.0
3. < 0.00
4. 0.001
5. 0.0001
6. 0.00001

I.e., the first 3 items are formatted correctly but the values have all been changed to 0. As I am using "cell.Value" in each block I suspect this is the source of my problem but can't quite figure it out. Can anyone shed any light on this?

Answer 1

You can have two conditions and one default in a custom Range.NumberFormat property. You need to use the # symbol to allow the possibility of additional decimal places. Use a custom number format of,

With ActiveWorkbook.Worksheets("Sheet1")
    .range("B2:B7").NumberFormat = "[>1]< 0;[>0]< 0.0####; 0; @"
    'maybe that should have been
    '.range("B2:B7").NumberFormat = "[>1]< 0;[>0]< 0.0####;< 0; @"
End With

The values in B2:B7 should be numbers only; do not type the < symbol.

Answer 2

Previous problem was solved thanks to Vincent G's help.

While scaling this up, however, I have run into another problem: with multiple instances of cells which need re-formatting, the VBA works just as intended for custom formats "< 0.0" through "< 0.00000", but for some reason it copies the same value for the first instance of "<0" it encounters into all other instances of this formatting.

It's a little painful to describe so please check out my example spreadsheet on Dropbox: the sheet has test data, the VBA, and a description of the issue.

Cheers, Christian