Find/replace help
That works perfectly :-) Thanks very much.
Steve
"Tom Ogilvy" wrote in message ...
This assumes no spaces in your list.
Option Explicit
Sub SetNumbers()
Dim iNum As Long, cnt As Long
Dim lNum As Long, Preface As String
Dim sStr As String, rng As Range
Dim iloc As Long
sStr = ActiveCell.Value
iNum = GetNumber(sStr, cnt, iloc, Preface)
lNum = Application.InputBox("Enter Start Number", _
"Start Number", iNum + 1, , , , , 1)
Set rng = ActiveCell
Do While Not IsEmpty(rng)
If UCase(Left(rng, iloc - 1)) = UCase(Preface) Then
rng.Value = Preface & _
Format(lNum, String(cnt, "0"))
lNum = lNum + 1
End If
Set rng = rng.Offset(1, 0)
Loop
End Sub
Public Function GetNumber(sStr As String, cnt As Long, _
iloc As Long, sStr2 As String)
Dim sChr As String
Dim sStr1 As String
Dim i As Long
For i = 1 To Len(sStr)
sChr = Mid(sStr, i, 1)
If IsNumeric(sChr) Then
If iloc = 0 Then iloc = i
sStr1 = sStr1 & sChr
ElseIf iloc = 0 Then
sStr2 = sStr2 & sChr
End If
Next
cnt = Len(sStr1)
GetNumber = CLng(sStr1)
End Function
--
Regards,
Tom Ogilvy
|