-
What you need ia a RegExp expert, but til one comes along try this
It needs a two column table called (Correct) with original and corrected in each row. Change i to suit (set for 3 rows
[vba]Sub check()
Dim Cor As Range, Chk As String, Rep As String
Set Cor = Range("Correct")
For i = 1 To 5 Step 2
Chk = Cor(i) & " "
Rep = Cor(i + 1) & " "
DoReplaceLeft Chk, Rep
Next
For i = 1 To 5 Step 2
Chk = " " & Cor(i)
Rep = " " & Cor(i + 1)
DoReplaceRight Chk, Rep
Next
For i = 1 To 5 Step 2
Chk = " " & Cor(i) & " "
Rep = " " & Cor(i + 1) & " 2"
DoReplaceMid Chk, Rep
Next
End Sub
Sub DoReplaceLeft(Chk As String, Rep As String)
With ActiveSheet.UsedRange
Set c = .Find(Chk, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lt = Len(Chk)
rt = Len(c)
If Left(c, lt) = Chk Then
c.Formula = Rep & Right(c, rt - lt)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Sub DoReplaceRight(Chk As String, Rep As String)
With ActiveSheet.UsedRange
Set c = .Find(Chk, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lt = Len(Chk)
rt = Len(c)
If Right(c, lt) = Chk Then
c.Formula = Left(c, rt - lt) & Rep
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Sub DoReplaceMid(Chk As String, Rep As String)
With ActiveSheet.UsedRange
Set c = .Find(Chk, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Formula = Application.WorksheetFunction.Substitute(c.Formula, Chk, Rep)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules