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
```

`Split`

you can also use regular expressions to look for`([^0-9])0\.`

an replace to`$1.`

. You can find plenty of tutorials on the net on using regular expressions in VBA.`split`

or`regular expressions`

these may work. Did either of you intend to write a answer? I would assume there would have to be some if/then to distinguish between`0.`

and`([^0-9])0\.`

. I'm not a programmer, although I try to be logical when writing most of the time.