How to loop this code?

[schnellvin]

Hi I would like to use a loop to do a find and replace in excel.

Here is the code

Sub findConvertGas()

Set rng1 = Cells.Find(What:="CO[2]", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If rng1 Is Nothing Then
MsgBox ("No CO[2] to convert")
Else
rng1.Activate
'run sub procedure
Call convertCO2
End If

End Sub

Any help is appreciated. Thanks
Schnellvin

 

[hippiehacker]

in which column are the CO[2] values?

 

[schnellvin]

Here is the sub procedure for convertCO2

Sub convertCO2()
Dim NumSub
Dim SubL
Dim SubR
Dim CheckSub
Dim CounterSub
Dim cell
'
CheckSub = True
CounterSub = 0
cell = ActiveCell
'
NumSub = Len(cell) - Len(Application.WorksheetFunction.Substitute(cell, "[", ""))
'
If Len(cell) = 0 Then Exit Sub
If IsError(Application.Find("[", ActiveCell, 1)) = False Then

Do
Do While CounterSub <= 1000
SubL = Application.Find("[", ActiveCell, 1)
SubR = Application.Find("]", ActiveCell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
End If
'
'
Call noFill
'
End Sub

 

[schnellvin]

got the solution by reusing the loop from convertCO2

Sub findConvertGas()
'
' This procedure will search for the defined Gasses and call sub procedure Super_Sub when required
'
'
Dim CheckCO2
Dim CounterCO2

CheckCO2 = True
CounterCO2 = 0

Do
Do While CounterCO2 <= 1000
'On Error Resume Next
Set rng2 = Cells.Find(What:="CO[2]", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

'On Error GoTo 0
If rng2 Is Nothing Then
'MsgBox ("No CO[2] to normalize")
Else
rng2.Activate
Call Super_Sub
End If

CounterCO2 = CounterCO2 + 1

If CounterCO2 = 100 Then
CheckCO2 = False
Exit Do
End If

Loop
Loop Until CheckCO2 = False

End Sub

 

[hippiehacker]

try this using the find next method

Sub findnext()
With Worksheets(1).UsedRange
    Set c = .Find("CO[2]", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Set c = .findnext(c)
             Call convertCO2(Range(c.Address))
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
    MsgBox ("No CO[2] to convert")
    End If
End With
End Sub



Sub convertCO2(cell As Range)
Dim NumSub
Dim SubL
Dim SubR
Dim CheckSub
Dim CounterSub
'
CheckSub = True
CounterSub = 0

'
NumSub = Len(cell) - Len(Application.WorksheetFunction.Substitute(cell, "[", ""))
'
If Len(cell) = 0 Then Exit Sub
If IsError(Application.Find("[", cell, 1)) = False Then

Do
Do While CounterSub <= 1000
SubL = Application.Find("[", cell, 1)
SubR = Application.Find("]", cell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
End If
'
'
Call noFill
'
End Sub

 

[schnellvin]

try this using the find next method

Sub findnext()
With Worksheets(1).UsedRange
    Set c = .Find("CO[2]", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Set c = .findnext(c)
             Call convertCO2(Range(c.Address))
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
    MsgBox ("No CO[2] to convert")
    End If
End With
End Sub



Sub convertCO2(cell As Range)
Dim NumSub
Dim SubL
Dim SubR
Dim CheckSub
Dim CounterSub
'
CheckSub = True
CounterSub = 0

'
NumSub = Len(cell) - Len(Application.WorksheetFunction.Substitute(cell, "[", ""))
'
If Len(cell) = 0 Then Exit Sub
If IsError(Application.Find("[", cell, 1)) = False Then

Do
Do While CounterSub <= 1000
SubL = Application.Find("[", cell, 1)
SubR = Application.Find("]", cell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
End If
'
'
Call noFill
'
End Sub

The code you gave resulted in an endless loop. The findNext procedure target the selected cells only and so it is not scanning through the whole worksheet.

 

[hippiehacker]

in line 2 the code is looking in Sheet 1 in Used.range you might need to change this to suit your sheet and Range.