Need help getting these 2 codes to work together

klarowe

Active Member
Joined
Mar 28, 2011
Messages
389
I have these two codes and separately they work perfectly. However if I run the "Add more parts" code then try to alter the index by checking/unchecking boxes, the index code throws an error regarding the OLEObjects. Is there a way to tell the index code to ignore any sheets containing the name "Additional Parts (#)"???? Or someway else to get it to work together without modifying the index numbering?

Add more parts code:
Code:
Sub AddMoreParts()
    Sheets.Add Type:= _
        "S:\SERVICE\Shop Teardown Reports\Teardown Templates\Additional Parts Template.xlt"
    ActiveSheet.Move after:=Worksheets(Worksheets.Count)
End Sub

Index Code:
Code:
Private Sub CheckBox1_Click()
    Dim i As Integer
    For i = 2 To 25
        ActiveSheet.OLEObjects("CheckBox" & i).Object.Value = ActiveSheet.CheckBox1.Value
    Next i
    Application.Run "IndexNumber"
End Sub
 
Private Sub CheckBox2_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox3_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox4_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox5_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox6_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox7_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox8_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox9_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox10_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox11_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox12_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox13_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox14_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox15_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox16_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox17_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox18_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox19_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox20_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox21_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox22_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox23_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox24_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub CheckBox25_Click()
    Call Chkbox
    Run ("IndexNumber")
End Sub
 
Private Sub Chkbox()
    For i = 6 To ActiveWorkbook.Worksheets.Count
        x = (i - 4)
            Sheets(i).Visible = ActiveSheet.OLEObjects("Checkbox" & x).Object.Value
    Next
End Sub

And just incase you need it, here is the index numbering code:
Code:
Sub IndexNumber()
    Dim lx As Long
    Dim sIndex As String
    Dim sIndexStartRange As String
    Dim lVisibleCount As Long
    sIndex = "Index"
    sIndexStartRange = "A7"
    Worksheets(sIndex).Range("A7:A100").Cells.ClearContents
    With Worksheets(sIndex).Range("A7")
        For lx = 1 To Worksheets.Count
            Select Case Worksheets(lx).Name
            Case Else
                If Worksheets(lx).Visible = True Then
                    lVisibleCount = lVisibleCount + 1
                End If
                If Worksheets(lx).Visible = True Then .Offset(lx - 1, 0) = lVisibleCount
            End Select
        Next
    End With
End Sub

Thanks in advance!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Is there a way to tell the index code to ignore any sheets containing the name "Additional Parts (#)"????

You're pretty much there. Your code already has a CASE statement in it. With just a bit of modification you could easily test the worksheet names. Here is an example using the LIKE operator. Note the inclusion of the OPTION COMPARE TEXT statement at the top of the module.

Code:
Option Compare Text   '// needs to be the first non-comment line in the module.
 
Sub Fooey()
 
    v = Array("Bob", "John", "Billy", "Jonah", "Boris", "Jimmy")
 
    For Each s In v
 
    Select Case True
 
        Case s Like "Bo*"
 
            MsgBox s & " is like pattern ""Bo*""", vbInformation
 
 
        Case s Like "Jo*"
 
            MsgBox s & " is like pattern ""Jo*""", vbInformation
 
        Case Else
 
            MsgBox s & " is not like any pattern", vbInformation
 
    End Select
 
    Next s
 
End Sub
 
Upvote 0
I am getting the error in the "chkbox" code though, not the index numbering code... although the numbering doesn't work either so I'll still have to change that.

The error is on this line:
Sheets(i).Visible = ActiveSheet.OLEObjects("Checkbox" & x).Object.Value
It says "unable to get the OLEObjects property of the worksheets class"
 
Upvote 0
Looking at it, I think the chkbox code is getting screwy because with that extra sheet being added for Additional parts, there are no longer corresponding checkboxes to the total number of sheets in the workbook.

A work-around I could do is instead of adding a sheet for additional parts, if there was a way to get a code to go to the first line of the next page on a sheet then I can add the extra lines to a new page rather than a new sheet. And that would solve everything. So how can that be done????
 
Upvote 0
...I think the chkbox code is getting screwy because with that extra sheet being added for Additional parts, there are no longer corresponding checkboxes to the total number of sheets in the workbook.

Erm, yeah, that would certainly do it.

A work-around I could do is instead of adding a sheet for additional parts, if there was a way to get a code to go to the first line of the next page on a sheet then I can add the extra lines to a new page rather than a new sheet. And that would solve everything. So how can that be done????

What do you mean by "page"? As per printed out pages?
 
Upvote 0
By page I mean after a page break. For example if you were to view the page break preview, then it would be the following "page" within the same worksheet. But yea, it would technically be the printed out pages within a sheet.

One way to do it (a little odd, but I think it would work) would be to have a code that follows these steps:
1. Find the last row with text and offset 2 rows (give 1 row of "buffer")
2. Insert page break.
3. Copy important rows from another workbook (or even better the template if I can)
4. Paste Rows into original document (after the page break that was just inserted) with keeping the same row formatting.
 
Last edited:
Upvote 0
Here is where I'm at with the above possible solution:
Code:
Sub Test()
    Application.ScreenUpdating = False
    Dim wbk As Workbook
    strFile = "S:\SERVICE\Shop Teardown Reports\Teardown Templates\Additional Parts Template1"
    Set wbk = Workbooks.Open(strFile)
    With wbk.Sheets("Additional Parts")
        Rows("1:59").Copy
    End With
    wbk.Close
    ActiveSheet.Range("A65536").End(xlUp).Offset(2, 0).Select
    With Selection
        ActiveSheet.HPageBreaks.Add Before:=ActiveCell
        .Insert Shift:=xlDown
        '.Value = "YES"
    End With
    Application.ScreenUpdating = True
End Sub

If I just deal with the finding the last row, inserting a page break, offsetting the row then use the ".value = "YES"" Then I get "YES" exactly where I need it. I just can't seem to copy the rows from one workbook into the original workbook.

If I use the exact code above and comment out the ".insert shift:= xldown" and uncomment ".value = "YES"" Then I can get it to no error out, but it seems to be copying rows 1:59 of the activesheet, not the sheet from the template workbook....
 
Last edited:
Upvote 0
Ok, I've just about got it figured out. Everything seems to work great I just need to figure out how to keep the pop-up box about saving things to the clipboard when the template workbook is closed.
Code:
Sub Test()
    Application.ScreenUpdating = False
    Dim wbk2 As Workbook
    Dim Dest As Range
    
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Select
        With Selection
            ActiveSheet.HPageBreaks.Add Before:=ActiveCell
        End With
        
    Set Dest = ActiveSheet.Range("A65536").End(xlUp).Offset(2, 0)
    Set wbk2 = Workbooks.Open(Filename:="S:\SERVICE\Shop Teardown Reports\Teardown Templates\Additional Parts Template1")
    wbk2.Sheets("Template").Rows("1:53").Copy
    
        Dest.Insert Shift:=xlDown
        
    wbk2.Close
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,537
Messages
6,179,405
Members
452,911
Latest member
a_barila

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