How to combine these two procedures into one?

ajjava

New Member
Joined
Dec 11, 2018
Messages
47
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:

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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
 

ajjava

New Member
Joined
Dec 11, 2018
Messages
47
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?

[URL="https://imgur.com/sEZbbrN"][IMG]http://i.imgur.com/sEZbbrN.jpg[/URL][/IMG]
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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.
 

ajjava

New Member
Joined
Dec 11, 2018
Messages
47

ADVERTISEMENT

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.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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.
 

ajjava

New Member
Joined
Dec 11, 2018
Messages
47

ADVERTISEMENT

Oh, that's a good idea. Ok, I will load the file once I get into the office tomorrow morning. Thanks for the suggestion!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
The vba code has a password
 

ajjava

New Member
Joined
Dec 11, 2018
Messages
47
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,109,540
Messages
5,529,434
Members
409,876
Latest member
Akash Yadav
Top