How to combine these two procedures into one?

ajjava

Board Regular
Joined
Dec 11, 2018
Messages
57
Office Version
  1. 365
Platform
  1. Windows
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
Code:
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
Code:
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
 
Last edited:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Try this

Code:
Sub AddCheckBoxes()


    'Defining variables/objects
    Dim currentSheet As Worksheet, currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long, pictureCountTotal As Long
    Dim wholeSheet As Range, findWords As Variant, b As Range
    
    '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
            
            Set wholeSheet = currentSheet.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 word In findWords
                Set b = wholeSheet.Find(word, LookIn:=xlValues, lookat:=xlWhole)
                If Not b Is Nothing Then
                    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  '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
            
        End If
    Next currentSheet
        
    'Another error handler
    If pictureCountTotal = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
    
End Sub
 
Upvote 0
Thank you very much. One odd behavior that I'm hoping you can diagnose - for some reason, the macro is not adding the checkbox in all the defined places.
As it relates to the 2nd proc I posted above, the code should:

* Look for defined words in the sheet
* If that word is found, put a checkbox in a location relative to the cell that the word is in

When I run the combined code above, the macro does indeed loop through all the sheets (there are 20+ of them). HOWEVER, it skips certain (random) occurrences of the defined trigger words.
When all is said and done, each sheet should have a total of 8 checkboxes - 4 for each picture object and another 4 for the trigger words.
Currently, the code above produces anywhere from 6 to 8 checkboxes.
Why would that be?

sEZbbrN.jpg
[/URL][/IMG]
 
Upvote 0
the macro has several considerations that you must review: it excludes aheets, it only applies in a range of cells and starts to put from the second image.
 
Upvote 0
So nothing jumps out at you, in terms of what could be causing this? I've stared at the code for hours now and I'm just not well-versed enough to sort out what's going wrong.
 
Upvote 0
You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Oh, that's a good idea. Ok, I will load the file once I get into the office tomorrow morning. Thanks for the suggestion!
 
Upvote 0
Does that prevent you from accessing the VB editor entirely for that workbook? Because the code that's in there (and the protection) is systematic, so I don't think I can unprotect it.
BUT, I didn't copy the code you put together for me into that workbook, anyway.
I've been running it from my Personal.xlsb workbook. Are you able to do that?
 
Upvote 0

Forum statistics

Threads
1,214,545
Messages
6,120,128
Members
448,947
Latest member
test111

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top