Retry - Find and Replace Macro

S

saturnin02

Hi,
(XL 2002, Win XP--VB Newbie)

I have in cells
A1 = mm97z.60
B1 = mm97z.15
C1 = mm97z.5
etc...

I need to create a macro that will look for the first digits it encouters in
the cells and replace then with same digits but +1 (e.g. the 97 in cell
A1 -->mm97z.60 would turn into 98 with result mm98z.60.

After reaching 99, it needs to continue not as 100, 101, etc., but as 00,
01, etc.

This needs to be done for a range of cells that are always in Column A but
with various possible lengths which I usually select manually with
Control\End Down Arrow.

Tx for the suggestions.
S
 
D

Dick Kusleika

S

Try this

Sub Add1()

Dim cell As Range
Dim Rng As Range
Dim i As Long
Dim lVal As Long
Dim sNew As String

Set Rng = Sheet1.Range("A1", _
Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp))

For Each cell In Rng.Cells
For i = 1 To Len(cell.Value)
If IsNumeric(Mid(cell.Value, i, 2)) Then
lVal = Val(Mid(cell.Value, i, 2))
sNew = Left(cell.Value, i - 1)
If lVal = 99 Then
lVal = 0
Else
lVal = lVal + 1
End If
sNew = sNew & Format(lVal, "00")
sNew = sNew & Right(cell.Value, Len(cell.Value) - i - 1)
cell.Value = sNew
Exit For
End If
Next i
Next cell

End Sub
 
S

saturnin02

You're the best Dick.
Works like a charm!
It will save me loads of time.
Tx a lot!
S
 
S

saturnin02

Dick,
I copied and pasted it in a test workbook and it worked great.
I then opened the "target" workbook did the same procedure, open VB Editor,
Add Module and Copy and pasted the code in it and NOTHING happens at all.
I cannot figure it out.
Here is how it appears in the VB Editor:

Sub Add1()

Dim cell As Range
Dim Rng As Range
Dim i As Long
Dim lVal As Long
Dim sNew As String

Set Rng = Sheet1.Range("A1", _
Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp))

For Each cell In Rng.Cells
For i = 1 To Len(cell.Value)
If IsNumeric(Mid(cell.Value, i, 2)) Then
lVal = Val(Mid(cell.Value, i, 2))
sNew = Left(cell.Value, i - 1)
If lVal = 99 Then
lVal = 0
Else
lVal = lVal + 1
End If
sNew = sNew & Format(lVal, "00")
sNew = sNew & Right(cell.Value, Len(cell.Value) - i - 1)
cell.Value = sNew
Exit For
End If
Next i
Next cell

End Sub

Am I missing something...?
S
 
S

saturnin02

Dick, I think I know why.
In the target workbook, the find and replace is not in Sheet 1 but changes
as number of sheets are added.
I guess I need to modify the macro and replace where it says sheet1 to ...is
it Active Window or something similar...?
Tx,
S
 
S

saturnin02

Dick,
This is what I did:
(seems to work--let me know if I did it right or not)--I changed Sheet1 with
ActiveSheet)

Sub Add2()

Dim cell As Range
Dim Rng As Range
Dim i As Long
Dim lVal As Long
Dim sNew As String

Set Rng = ActiveSheet.Range("A1", _
ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp))

For Each cell In Rng.Cells
For i = 1 To Len(cell.Value)
If IsNumeric(Mid(cell.Value, i, 2)) Then
lVal = Val(Mid(cell.Value, i, 2))
sNew = Left(cell.Value, i - 1)
If lVal = 99 Then
lVal = 0
Else
lVal = lVal + 1
End If
sNew = sNew & Format(lVal, "00")
sNew = sNew & Right(cell.Value, Len(cell.Value) - i - 1)
cell.Value = sNew
Exit For
End If
Next i
Next cell

End Sub
 
D

Dick Kusleika

This is what I did:
(seems to work--let me know if I did it right or not)--I changed Sheet1 with
ActiveSheet)
Click to expand...

Looks good to me. The important thing is that it works.
 
Top