Best loop to use?

[YellowLabPro]

I need to search for "Ii" and replace w/ "II"
also "Iii" and w/ "III"
I also need to be careful that "Ii" is treated as a separate word and not as if it were in the middle of a string. What is happening is I am converting the string to Proper, and roman numerals are being changed to Proper, but I need them to remain in Upper case.

I am here:
[vba]For i = 2 To LastRow
Range("D" & i).Find("ii").Replace ("II")
Next i[/vba]
[vba]
LastRow = Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Range("E" & i) = Application.WorksheetFunction.Proper(Trim(Range("D" & i)))
Next i
For i = 2 To LastRow
Range("D" & i).Find("ii").Replace ("II")
Next i
[/vba]

[mdmackillop]

Are you only dealing with 1 to 3 or with higher values as well?

[YellowLabPro]

I am only dealing w/ 1-3.
But thinking about it this column may have other values that I might want to replace, Jkt w/ Jacket, Pnt w/ Pant.
And I started thinking about some sort of table.

[YellowLabPro]

It is actually 2 and 3, II and III

[mdmackillop]

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]

[YellowLabPro]

I am starting this now....
What is a RegExp expert, or should I ask....

[mdmackillop]

Matt (mvidas) is the most regular, and Dave Brett (BrettDJ). There are some KB items if you're feeling like a challenge

[YellowLabPro]

Ok,
Malcolm you have confused the heck out of the little fella over here...
Some variables are not defined, i, c
I defined i as Long,
I do not know what c should be

I set up a table named "Correct" on the Table worksheet in the same book
I have 5 rows of data to check for
Ii II
Iii III
Jkt Jacket
Pnt Pant
Whl Wheel

I cannot tell if it the program knows where to look, I am guessing the named table "Correct".
I am only running this in one column, "D" on the worksheet DataEdited

[YellowLabPro]

Damn Malcolm you have sent me into the lion's den on this one....
Regular Expressions....

[mdmackillop]

Apologies for being sloppy, I'm watching the Masters Golf.
Dim c As Range, i As Long, lt As Long, rt As Long, firstaddress As String

With 5 rows, use "For i = 1 to 9 Step 2"

Keep "Correct" on a separate sheet from the data you wish to check. The code as written checks the activesheet.
Change
With ActiveSheet.UsedRange to
With Sheets("DataEdited").Columns(4)
to check the location specified.

[mdmackillop]

Damn Malcolm you have sent me into the lion's den on this one....
Regular Expressions....

I've stayed well clear of it myself!

[YellowLabPro]

To get around the varible requirements I commented out Option Explicit.
Once the program starts, it does not give any indication it is doing anything, so I ctl+brk and get a run-time error 1004
"Unable to get the FindNext property of the Range class"

[YellowLabPro]

No problem...
Let me make the changes you gave me last....

[YellowLabPro]

M-
I have it running. It takes about 5 minutes to loop through all the cells. It did not change all of them. I am not sure if it ran out of memory? Also I found there are a records that are need to be changed that do not have a space, example 2Pnt.
I am not sure how difficult it will be to factor this in.
Since I have no idea what went into this, I am throwing this out for consideration, what about using an auto-filter in the code and then do the replace that way. Is that possible?

[mdmackillop]

Hi Yelp,
I've applied it to this sample, but the code breaks down for some reason. A different method is needed I think

[YellowLabPro]

From your workbook I get an error for
[VBA]
Loop While Not c Is Nothing And c.Address <> firstaddress
[/VBA]
Object variable or With block variable not set

I cannot offer an opinion one way or the other... but with reading other random posts, the autofilter method. Is this a possibility?

[Aussiebear]

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
'.... uhoh Tiger's dropped one in the water
[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) & " "
'... Ogilvy has feathered one on the 15th green from 145 meters out
DoReplaceLeft Chk, Rep
Next
[/vba]

[mdmackillop]

I don't see how autofilter can be used.
While this may not work in mixed text, It might suffice for this
[VBA]Sub Test()
Dim Ws As Worksheet, c As Range
Set Ws = Sheets("DataEdited")
With Ws
For Each c In Intersect(Ws.Columns(4), Ws.UsedRange)
If InStr(c, "Ii") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, "Ii", "II")
If InStr(c, "Iii") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, "Iii", "III")
If InStr(c, "Jkt") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, "Jkt", "Jacket")
If InStr(c, "Pnt") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, "Pnt", "Pant")
If InStr(c, "Whl") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, "Whl", "Wheel")
Next
End With
End Sub

[/VBA]

[YellowLabPro]

M-
That worked great. The other was one was just sucking up all the memory.
What do you mean by mixed text?

[mdmackillop]

I don't know of any words that start Ii...., but that may not be the case with all abreviations, so this code will fail. eg Change Rd to Red, but what about "Third". My first code would handle that, but the PC wouldn't.