CODEWITHSUNDEEP
vbaexcelloops
Rhyfelwr
Rhyfelwr

Reputation: 329

Trying to find a set of letters within a string with a loop

I am trying to make a loop that checks all the cells in column A and if it finds that any of them contains the phrase "ISAW" within a string (like 1314_ISAW_STUFF) then it changes the value of the corresponding cell in column G to "COMPLIANT".

I have the following code, the loop works and the Cells.Find option should work but it doesn't activate any cells with matching criteria. 

Sub mytestsub()

Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")

Dim i As Integer
sh1.Activate

On Error GoTo MyError
For i = 1 To InStr(ActiveSheet, "ISAW")
    sh1.Cells.Find("ISAW").Activate
    If InStr(ActiveCell, "ISAW") > 0 Then
        ActiveCell.Offset(, 7).Value = "COMPLIANT"
    End If
Next i

MyError:
On Error GoTo -1

End Sub

Any help would be appreciated!

I altered the script Tom generously provided as seen below, but it doesn't seem to be working now.

 Sub bugfix()
'QA N/A bugfix'
    Dim fndCell As Range
    Dim FirstAddress As String
    Worksheets("Summary").Unprotect
With Worksheets("Summary")
        .Activate


        On Error GoTo MyError
        Set fndCell = .Column(3).Find(what:="ISAW", lookat:=xlPart)
        If Not fndCell Is Nothing Then
         ' uncomment if you really want to visually track the cells
            'fndCell.Activate
            FirstAddress = fndCell.Address
            Do
                fndCell.Offset(0, 6).Value = "N/A"
                Set fndCell = .Cells.FindNext(fndCell)
            Loop Until fndCell.Address = FirstAddress
        End If
    End With
Exit Sub
MyError:
    On Error GoTo -1
End Sub

Upvotes: 0

Views: 79

Answers (3)

Tom
Tom

Reputation: 9878

Use Find and FindNext to do this. This will find all cells in Sheet1 that contain "ISAW" and update the values in column G. Also, with error handling make sure to Exit Sub before your error handling process otherwise it'll run whether there is an error or not.

Updated after comments

The reason it's not doing anything is because your code actually has an error BUT it is being masked by your On Error GoTo MyError. I've updated with a fixed code

Sub bugfix()
    'QA N/A bugfix'
    Dim fndCell As Range
    Dim FirstAddress As String

    With Worksheets("Summary")
        .Unprotect
        .Activate
        On Error GoTo MyError
        Set fndCell = .Columns(3).Find(what:="ISAW", lookat:=xlPart)
        If Not fndCell Is Nothing Then
         ' uncomment if you really want to visually track the cells
            'fndCell.Activate
            FirstAddress = fndCell.Address
            Do
                fndCell.Offset(0, 6).Value = "N/A"
                Set fndCell = .Columns(3).FindNext(fndCell)
            Loop Until fndCell.Address = FirstAddress
        End If
    End With
    Exit Sub
MyError:
    On Error GoTo -1
End Sub

Upvotes: 0

Gary Evans
Gary Evans

Reputation: 1890

I can appreciate there could be good reason to use VBA but May I suggest a formula as an option, in first data cell in column G and then copied down

=IF(ISERR(FIND("ISAW",A1,1)),"","COMPLIANT")

This looks for your string if it finds it then its start position is returned, if it doesn't then it returns #VALUE. The encapsulating IF statement converts this to COMPLIIANT or empty.

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33682

There's almost never a reason to Activate or use ActiveCell in order to check a certain value, or change another cell's value. Instead, use fully qualified objects.

Also, using On Error GoTo MyError is not necessary in this case, see code below.

Code

Sub mytestsub()

Dim sh1 As Worksheet
Dim i As Long, LastRow As Long

Set sh1 = Worksheets("Sheet1")
With sh1
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"
    For i = 1 To LastRow
        If InStr(.Range("A" & i).Value2, "ISAW") > 0 Then ' check if current cell in column "A" contains "ISAW"
            .Range("G" & i).Value2 = "COMPLIANT" ' change the value at column "G"
        End If
    Next i
End With

End Sub

Upvotes: 1

Related Questions