remove leading 0 in front of decimal except when a a non-zero number precedes it

I have a column, which has a comma separated values inside each cell that look like this

0.1, 0.2,0.3, 0.4,0.5, 0.8,1.0
1.5, 1.6,2.0, 10.6,10.9, 15.2,30.75
20, 0.25,280.2, 0.29,300.2, 423,530.76

Like a text string.

The goal is to remove the leading zero in front of the decimal, but only when there is no other digit (including another 0) in front of it I use the search replace function vba:

    Option Explicit
    Public Sub Replace0dot(Optional byDummy As Byte)
        Columns("A").Replace What:"0.", _
                            Replacement:=".", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False
    Application.ScreenUpdating = True
    End Sub 

and I end up with this:

.1, .2,.3, .4,.5, .8,1
1.5, 1.6,2, 1.6,1.9, 15.2,3.75
2, .25,28.2, .29,30.2, 423,53.76

It removes all instances of leading 0. with ., so you see 10.6 becomes 1.6. But it should remain 10.6 How can I get a search replace equivalent that gives me:

.1, .2,.3, .4,.5, .8,1
1.5, 1.6,2, 10.6,10.9, 15.2,30.75
20, .25,280.2, .29,300.2, 423,530.76

??? Seems like there would have to be un-concatenate and re-concatenate to achieve the goal.

Solution 1:

Here is a very simple approach:

• if the string begins with 0. then drop the zero
• if the string contains triplets like {space}0. then drop that zero
• if the string contains triplets like ,0. then drop that zero

Select the cells and run this code:

Sub fixdata()
    Dim r As Range, t As String

    For Each r In Selection
        t = r.Text
        If Left(t, 2) = "0." Then t = Mid(t, 2)
        t = Replace(t, " 0.", " .")
        t = Replace(t, ",0.", ",.")
        r.Value = t
    Next r
End Sub

before:

and after:

If there are other triplets that must be changed, just add another Replace()

EDIT#1:

To avoid manual selection of the cells, we can have the macro do it.........here is an example for column A:

Sub fixdata2()
    Dim r As Range, t As String

    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        t = r.Text
        If Left(t, 2) = "0." Then t = Mid(t, 2)
        t = Replace(t, " 0.", " .")
        t = Replace(t, ",0.", ",.")
        r.Value = t
    Next r
End Sub

EDIT#2

In this version we append a ; to the end of each cell just before entering text into that cell:

Sub fixdata3()
    Dim r As Range, t As String, Suffix As String
    Suffix = ";"

    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        t = r.Text
        If Left(t, 2) = "0." Then t = Mid(t, 2)
        t = Replace(t, " 0.", " .")
        t = Replace(t, ",0.", ",.")
        r.Value = t & Suffix
    Next r
End Sub

EDIT3#:

In this version the ; is appended only if it not already present in the cell:

Sub fixdata4()
    Dim r As Range, t As String, Suffix As String
    Suffix = ";"

    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        t = r.Text
        If Left(t, 2) = "0." Then t = Mid(t, 2)
        t = Replace(t, " 0.", " .")
        t = Replace(t, ",0.", ",.")
        If Right(t, 1) <> Suffix Then
            r.Value = t & Suffix
        End If
    Next r
End Sub

EDIT#4:

This version will not affect empty cells:

Sub fixdata5()
    Dim r As Range, t As String, Suffix As String
    Suffix = ";"

    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        t = r.Text
        If t <> "" Then
            If Left(t, 2) = "0." Then t = Mid(t, 2)
            t = Replace(t, " 0.", " .")
            t = Replace(t, ",0.", ",.")
            If Right(t, 1) <> Suffix Then
                r.Value = t & Suffix
            End If
        End If
    Next r
End Sub

EDIT#5:

This fixes the bug in the previous version:

Sub fixdata6()
    Dim r As Range, t As String, Suffix As String
    Suffix = ";"

    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        t = r.Text
        If t <> "" Then
            If Left(t, 2) = "0." Then t = Mid(t, 2)
            t = Replace(t, " 0.", " .")
            t = Replace(t, ",0.", ",.")
            If Right(t, 1) <> Suffix Then
                t = t & Suffix
            End If
            r.Value = t
        End If
    Next r
End Sub