How to combine these two procedures into one?

[ajjava]

I have two procedures that will ultimately be run on the same workbook. (see below)

I've gotten each procedure to work on its own.

Now I'd like to combine them into one.

I tried to have the 1st proc call the 2nd proc, but that failed (no doubt because of me).

I then tried to modify the code in the 2nd proc so that it would loop through all sheets...and that wouldn't work either.

In a nutshell, the following should happen when the code is run:

* For each picture, on each sheet, add a checkbox
* For each (specified cell), on each sheet, add a checkbox
* Certain sheets will be ignored (as noted in the code) for both procedures

1st Procedure

Sub AddCheckBoxesToPicturesFINAL()


    'Defining variables/objects
    Dim currentSheet As Worksheet
    Dim currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long
    Dim pictureCountTotal As Long
    
    
    
    'Error handling message
    If TypeName(ActiveWorkbook) <> "Workbook" Then
        MsgBox "No workbook is active!", vbExclamation
        Exit Sub
    End If
    
    'Initializing a picture object counter
    pictureCountTotal = 0
    
    'A For Loop, that allows the macro to loop through ALL sheets in a workbook
    For Each currentSheet In ActiveWorkbook.Worksheets
        'This statement tells the macro to IGNORE these particular sheets
        If currentSheet.Name <> "New Raw Data Excel Output" And currentSheet.Name <> "Pending Raw Data Excel Output" And currentSheet.Name <> "Closed Raw Data Excel Output" And currentSheet.Name <> "Definition and Filter" Then   'enter names of sheets to ignore
                
                'Begins looking through each sheet, looking for picture objects. If one is found, add a checkbox with the caption "Select"
                pictureCount = 0
                For Each currentShape In currentSheet.Shapes
                    If currentShape.Type = msoPicture Then
                        pictureCount = pictureCount + 1
                        pictureCountTotal = pictureCountTotal + 1
                        If pictureCount > 1 Then
                            With currentShape
                                Set currentCheckBox = currentSheet.CheckBoxes.Add(Left:=.Left + 5, Top:=.Top + 5, Width:=65, Height:=18)
                                currentCheckBox.Caption = "Select"
                            End With
                        End If
                    End If
                Next currentShape
        End If
 
    Next currentSheet
        
    'Another error handler
    If pictureCountTotal = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
    
End Sub

2nd Procedure

Sub AddCheckBoxToTable()


Dim currentSheet As Worksheet
Dim chkbx As CheckBox
Dim findWords As Variant
Dim wholeSheet As Range
Dim cell As Range, word As Variant




For Each currentSheet In ActiveWorkbook.Worksheets


Set wholeSheet = ActiveSheet.Range("A6:AB50")       'UsedRange




findWords = Array("# Claim and TTD Days", "Claim Duration", "Claim Type", "Claimant Age", "Closed Claims", "Closed Count", "Closed Incurred", "Financial Overview", "Incurred Group", "Lag to Client", "Lag to Sedgwick", "Lit and Atty Rep", "Litigation Incurred", "Litigation Rate", "New Claims", "New Count", "New Incurred", "Over 2 Years", "Pending Claims", "Pending Count", "Pending Incurred", "Service Length", "Total Incurred", "TTD Days Strat")






            For Each cell In wholeSheet
                For Each word In findWords
                    If InStr(1, cell, word, vbTextCompare) Then
                        'cell.Interior.ColorIndex = 6
                        
                        Set chkbx = ActiveSheet.CheckBoxes.Add(Left:=cell.Offset(, -1).Left, Top:=cell.Offset(, -1).Top, Width:=25, Height:=0)
                            With chkbx
                                .Caption = "Select"
                                .Left = cell.Left + cell.Width - 60  'this is the part that determines where the checkbox is positioned and I don't really understand what it's doing but it works
                            End With
                        
                    End If
            
                Next word
            Next cell
Next currentSheet
End Sub

 

[DanteAmor]

Use this:

Sub AddCheckBoxes()
    'Defining variables/objects
    Dim currentSheet As Worksheet, currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long, pictureCountTotal As Long
    Dim r As Range, findWords As Variant, b As Range, celda as string
    
    'Error handling message
    If TypeName(ActiveWorkbook) <> "Workbook" Then
        MsgBox "No workbook is active!", vbExclamation
        Exit Sub
    End If
    'Initializing a picture object counter
    pictureCountTotal = 0
    
    'A For Loop, that allows the macro to loop through ALL sheets in a workbook
    For Each currentSheet In ActiveWorkbook.Worksheets
        'This statement tells the macro to IGNORE these particular sheets
        If currentSheet.Name <> "New Raw Data Excel Output" And _
            currentSheet.Name <> "Pending Raw Data Excel Output" And _
            currentSheet.Name <> "Closed Raw Data Excel Output" And _
            currentSheet.Name <> "Definition and Filter" Then   'enter names of sheets to ignore
                
            'Begins looking through each sheet, looking for picture objects. If one is found, add a checkbox with the caption "Select"
            pictureCount = 0
            For Each currentShape In currentSheet.Shapes
                If currentShape.Type = msoPicture Then
                    pictureCount = pictureCount + 1
                    pictureCountTotal = pictureCountTotal + 1
                    If pictureCount > 1 Then
                        With currentShape
                            Set currentCheckBox = currentSheet.CheckBoxes.Add(Left:=.Left + 5, Top:=.Top + 5, Width:=65, Height:=18)
                            currentCheckBox.Caption = "Select"
                        End With
                    End If
                End If
            Next currentShape
            
            findWords = Array("# Claim and TTD Days", "Claim Duration", "Claim Type", "Claimant Age", "Closed Claims", "Closed Count", _
                              "Closed Incurred", "Financial Overview", "Incurred Group", "Lag to Client", "Lag to Sedgwick", _
                              "Lit and Atty Rep", "Litigation Incurred", "Litigation Rate", "New Claims", "New Count", "New Incurred", _
                              "Over 2 Years", "Pending Claims", "Pending Count", "Pending Incurred", "Service Length", "Total Incurred", "TTD Days Strat")
            
            Set r = currentSheet.Range("A6:AB50")       'UsedRange
            
            For Each word In findWords
[COLOR=#0000ff]                Set b = r.Find(word, LookIn:=xlValues, lookat:=xlWhole)[/COLOR]
[COLOR=#0000ff]                If Not b Is Nothing Then[/COLOR]
[COLOR=#0000ff]                    celda = b.Address[/COLOR]
[COLOR=#0000ff]                    Do[/COLOR]
                        Set chkbx = currentSheet.CheckBoxes.Add(Left:=b.Left, Top:=b.Top, Width:=25, Height:=0)
                        With chkbx
                            .Caption = "Select"
                            .Left = b.Left + b.Width - 60  
                        End With
[COLOR=#0000ff]                        Set b = r.FindNext(b)[/COLOR]
[COLOR=#0000ff]                    Loop While Not b Is Nothing And b.Address <> celda[/COLOR]
[COLOR=#0000ff]                End If[/COLOR]
                
            Next word
            
        End If
    Next currentSheet
        
    'Another error handler
    If pictureCountTotal = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
End Sub

 

[ajjava]

Hmm. For some reason, I'm getting this error when I run it:

[/URL][/IMG]

 

[DanteAmor]

The detail is that you have merged cell P12 and P13 in the Pending What sheet. Try this one:

Sub AddCheckBoxes()
    'Defining variables/objects
    Dim currentSheet As Worksheet, currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long, pictureCountTotal As Long
    Dim r As Range, findWords As Variant, b As Range, celda As String
    
    'Error handling message
    If TypeName(ActiveWorkbook) <> "Workbook" Then
        MsgBox "No workbook is active!", vbExclamation
        Exit Sub
    End If
    'Initializing a picture object counter
    pictureCountTotal = 0
    
    'A For Loop, that allows the macro to loop through ALL sheets in a workbook
    For Each currentSheet In ActiveWorkbook.Worksheets
        'This statement tells the macro to IGNORE these particular sheets
        If currentSheet.Name <> "New Raw Data Excel Output" And _
            currentSheet.Name <> "Pending Raw Data Excel Output" And _
            currentSheet.Name <> "Closed Raw Data Excel Output" And _
            currentSheet.Name <> "Definition and Filter" Then   'enter names of sheets to ignore
                
            'Begins looking through each sheet, looking for picture objects. If one is found, add a checkbox with the caption "Select"
            pictureCount = 0
            For Each currentShape In currentSheet.Shapes
                If currentShape.Type = msoPicture Then
                    pictureCount = pictureCount + 1
                    pictureCountTotal = pictureCountTotal + 1
                    If pictureCount > 1 Then
                        With currentShape
                            Set currentCheckBox = currentSheet.CheckBoxes.Add(Left:=.Left + 5, Top:=.Top + 5, Width:=65, Height:=18)
                            currentCheckBox.Caption = "Select"
                        End With
                    End If
                End If
            Next currentShape
            
            findWords = Array("Litigation Incurred", "# Claim and TTD Days", "Claim Duration", "Claim Type", "Claimant Age", "Closed Claims", "Closed Count", _
                              "Closed Incurred", "Financial Overview", "Incurred Group", "Lag to Client", "Lag to Sedgwick", _
                              "Lit and Atty Rep", , "Litigation Rate", "New Claims", "New Count", "New Incurred", _
                              "Over 2 Years", "Pending Claims", "Pending Count", "Pending Incurred", "Service Length", "Total Incurred", "TTD Days Strat")
            
            Set r = currentSheet.Range("A6:AB50")       'UsedRange
            
            For Each word In findWords
                Set b = r.Find(word, LookIn:=xlValues, LookAt:=xlWhole, [COLOR=#0000ff]SearchOrder:=xlByColumns, _[/COLOR]
[COLOR=#0000ff]                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False[/COLOR])
                If Not b Is Nothing Then
                    celda = b.Address
                    Do
                        Set chkbx = currentSheet.CheckBoxes.Add(Left:=b.Left, Top:=b.Top, Width:=25, Height:=0)
                        With chkbx
                            .Caption = "Select"
                            .Left = b.Left + b.Width - 60
                        End With
                        Set b = r.FindNext(b)
                        laphoja = currentSheet.Name
                    Loop While Not b Is Nothing And b.Address <> celda
                End If
                
            Next word
            
        End If
    Next currentSheet
        
    'Another error handler
    If pictureCountTotal = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
End Sub

 

[ajjava]

That, sir, is perfect I am very grateful for your assistance and patience. Thank you!!!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.