Home > OS >  Loop through all sheets and look for value in range. If found then do some action and GoTo
Loop through all sheets and look for value in range. If found then do some action and GoTo

Time:12-15

I have quite simple piece of code below. I need it to loop through all sheets in workbook and look for particular value in range. If found then perform some actions (Get sheet name and store in temporary sheet) and go to another lines to complete rest of the code. Only one worksheet will contain this value or none. So if this value wont be find in any of those worksheets I want to run code from Step2. Workbook can contain even 20-30 sheets.

If i run this code with Else disabled it works fine. It finds sheet, complete If and performs rest of the code

However if value not found in any of sheets I would like to GoTo Step 2 to other sub. But whenever I have this Else: GoTo Step2: enabled it goes to Step2: just after checking first sheet withouth searched value.

Any idea what I am doing wrong. It is simple piece of code and I am getting crazy with it :)

Sub ProjectGCA1 ()

 Application.ScreenUpdating = False
 
 Dim ws, shGCA1 As Worksheet
    Dim wb As Workbook
        Dim i, j As Long
        
    Set wb = ThisWorkbook
               wb.Sheets.Add.Name = "Temporary storage"
            j = wb.Sheets.Count

   For i = 1 To j
    
        If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
            Set shGCA1 = wb.Sheets(i)
            wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
                wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
       
           'Else: GoTo Step2:

        End If
    Next i
Step1: 

' -----------------------rest of the code to work on shGCA1------------------------
' -----------------------rest of the code to work on shGCA1------------------------

Step2
Call ProjectGCA2

End Sub

CodePudding user response:

If you activate the else within the loop, of course the loop will be left at the first iteration. You need to check after the loop was finished if the sheet was found.
As far as I understand, you are setting shGCA1 to the sheet you found, so you can check if it was set or not. If you don't have such a variable, just create a boolean variable and set it to True if something was found. Important is that you check it after the loop was done.

For i = 1 To j
    If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
        Set shGCA1 = wb.Sheets(i)
        wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
        wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
        ' If you are sure there is at most one sheet, you can leave the loop now:
        Exit For
    End If
Next i

If Not shGCA1 Is Nothing then
    ' Do your stuff with the sheet.
Else
    ' Do the stuff if no sheet was found
End If

If the behavior of the program is not clear, I strongly advise to use the debugger and step thru the code line by line (using F8)

CodePudding user response:

Reference Worksheet With String In Cell

  • You could use the following function to reference the found worksheet:
Function RefWorksheetWithStringInCell( _
    ByVal wb As Workbook, _
    ByVal CellAddress As String, _
    ByVal CellString As String, _
    Optional ByVal MatchCase As Boolean = False) _
As Worksheet
    Const ProcName As String = "RefWorksheetWithStringInCell"
    On Error GoTo ClearError
    
    Dim CompareMethod As VbCompareMethod
    CompareMethod = IIf(MatchCase = False, vbTextCompare, vbBinaryCompare)
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If StrComp(CStr(ws.Range(CellAddress).Value), CellString, _
                CompareMethod) > 0 Then
            Set RefWorksheetWithStringInCell = ws
            Exit For
        End If
    Next ws

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function
  • Then you could rewrite your code in the following way:
' Now the loop is in the function.
Set shGCA1 = RefWorksheetWithStringInCell(wb, "A4", "Project Name: GCA1")

If shGCA1 Is Nothing Then ' not found
    ProjectGCA2 ' 'Call' is considered deprecated
    Exit Sub
Endif    

wb.Worksheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
wb.Worksheets("Temporary storage").Range("B1").Value = shGCA1.Name
' Continue...
  • Here's a function that would give you control over adding a worksheet, e.g. in case it already exists:
Function RefAddedWorksheet( _
    ByVal wb As Workbook, _
    ByVal WorksheetName As String, _
    Optional ByVal DoKeepExisting As Boolean = False) _
As Worksheet
    Const ProcName As String = "RefAddedWorksheet"
    On Error GoTo ClearError ' e.g. invalid sheet name

    Dim sh As Object ' e.g. chart
    Dim DoesWorksheetExist As Boolean
    
    On Error Resume Next
        Set sh = wb.Sheets(WorksheetName)
    On Error GoTo ClearError
    
    If Not sh Is Nothing Then ' sheet already exists
        If sh.Type = xlWorksheet Then ' is worksheet
            If DoKeepExisting Then ' keep
                DoesWorksheetExist = True ' flag it existing
            'Else ' don't keep
            End If
        'Else ' is chart
        End If
        If Not DoesWorksheetExist Then ' not flagged existing
            Application.DisplayAlerts = False ' delete without confirmation
                sh.Delete
            Application.DisplayAlerts = True
        'Else ' flagged existing
        End If
    'Else ' sheet doesn't exist
    End If
    
    If Not DoesWorksheetExist Then ' not flagged existing
        Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        On Error Resume Next
            sh.Name = WorksheetName
        On Error GoTo ClearError
    'Else ' flagged existing
    End If
    
    If StrComp(sh.Name, WorksheetName, vbTextCompare) = 0 Then ' valid name
        Set RefAddedWorksheet = sh
    Else ' invalid name
        Application.DisplayAlerts = False ' delete without confirmation
            sh.Delete
        Application.DisplayAlerts = True
    End If

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function
  • In your code, you could e.g. use it in the following way:
Const wsTempName As String = "Temporary storage"
Const wsTempDoKeepExisting As Boolean = False

Dim wsTemp As Worksheet
Set wsTemp = RefAddedWorksheet(wb, wsTempName, wsTempDoKeepExisting)

If wsTemp Is Nothing Then ' highly unlikely (if invalid name e.g. 'History')
    MsgBox "Could not create the '" & wsTempName & "' worksheet.", _
        vbCritical
    Exit Sub
End If
  • Note that the function adds the worksheet after the last sheet in the workbook.
  • Related