IF Exceptions VBA

Viewed 33

I have a macro that goes through all the sheets in a file and adds columns. I would like to add a condition so that it only adds these columns in sheets where a cell with the value "ABC" exists, and leaves the other sheets unchanged. What should the IF function look like?

**For Each ws In Worksheets
u = Application.WorksheetFunction.CountIfs(Range("A:QZ"), "ABC")
If u Then
ws.Activate**

End If
Next ws

Wb.Save
Wb.Close False
    strFil = Dir
Loop


End Sub
1 Answers

This might point you in the right direction - note there's no ActiveSheet or ActiveCell references. You rarely need them.

Not sure why you deleted the rest of the code in your question. It's still relevant.

Sub Test()

    Dim ws As Worksheet
    Dim Wb As Workbook
    Dim strFolder As String
    Dim strFil As String
    Dim FldrPicker As FileDialog
    Dim myFolder As String
    Dim FoundCell As Range
    Dim FirstAddress As String
    
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        strFolder = .SelectedItems(1) & "\"
      End With
    

    strFil = Dir(strFolder & "\*.xls*")
    Do While strFil <> vbNullString
        Set Wb = Workbooks.Open(strFolder & "\" & strFil)
    
        For Each ws In Wb.Worksheets 'Looking at sheets in wb, not necessarily the active file.
                
            'Better ways to check this, but it's early and I'm not thinking.
            On Error Resume Next
                ws.ShowAllData
            On Error GoTo 0
            
            Set FoundCell = ws.Cells.Find(What:="ABC", After:=ws.Cells(1, 1), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
            'No need to count ABC's - if it isn't found then code moves to the next sheet.
            If Not FoundCell Is Nothing Then
                FirstAddress = FoundCell.Address 'Remember first found address as FindNext will loop around.
                Do
                    FoundCell.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    Set FoundCell = ws.Cells.FindNext(FoundCell) 'https://docs.microsoft.com/en-us/office/vba/api/Excel.Range.Find
                Loop While FoundCell.Address <> FirstAddress 'Keeping looking until back at the start.
            End If
                
        Next ws
        
        Wb.Close True
        strFil = Dir
    Loop

End Sub
Related