Excel/VBA Macros assistance

Question

I am having a bit of trouble with some code and was wondering if someone could maybe assist. Basically I have 2 errors which I can't work out myself (too inexperienced with VBA, unfortunately)

Brief overview:

This macro is designed to generate a new workbook with copies of selected sheets from a "source" workbook in order to present to clients as a report batch. Essentially - we have master workbook "A" which may have 50 tabs or so, and we want to quickly select a couple of sheets to "copy" into a new workbook to save and send to a client. The code is a bit of a mess but I am not really sure what is going on/what I can remove etc.

Problems:

When you run the attached code/macro in Excel, it does everything it is supposed to do, however, it ALSO copies the sheet from which you run the macro. (i.e. I might be on sheet 1 in the Workbook. Run the macro to generate reports, checkbox menu appears and I select sheets 2, 5 & 9 - it will then copy into a new Workbook sheets 2, 5 & 9 AND sheet 1. But I never selected sheet 1 from the checkbox menu...)
Once this code has finished running, I am unable to save the Excel file. It just crashes and says "Microsoft Excel has stopped working" and then the file dies and I have to close Excel and recover etc. etc. I combined 2 pieces of code to get this working and I imagine I may be missing something crucial which is causing the problem. We have another piece of code to print sheets out in a similar way to this, and if I run this I am able to save with no problems.

Code:

I have included all the Visual Basic code (i.e. for the generate reports & print sheets macros).

I really don't have any experience with VBA so I hope someone will be able to assist! Thanks in advance :)

Sub PrintSelectedSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim Printdlg As DialogSheet
Dim CurrentSheet As Worksheet, wsStartSheet As Worksheet
Dim CB As CheckBox
Application.ScreenUpdating = False

'Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
    MsgBox "Workbook is protected.", vbCritical
    Exit Sub
End If

'Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set wsStartSheet = ActiveSheet
Set Printdlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

'Add the checkboxes

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
    Set CurrentSheet = ActiveWorkbook.Worksheets(i)
    'Skip empty sheets and hidden sheets
    If Application.CountA(CurrentSheet.Cells) <> 0 And _
        CurrentSheet.Visible Then
        SheetCount = SheetCount + 1
        Printdlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            Printdlg.CheckBoxes(SheetCount).Text = _
                CurrentSheet.Name
        TopPos = TopPos + 13
    End If
Next i

'Move the OK and Cancel buttons
Printdlg.Buttons.Left = 240

'Set dialog height, width, and caption
With Printdlg.DialogFrame
    .Height = Application.Max _
        (68, Printdlg.DialogFrame.Top + TopPos - 34)
    .Width = 230
    .Caption = "Select sheets to print"

End With

'Change tab order of OK and Cancel buttons
'so the 1st option button will have the focus
Printdlg.Buttons("Button 2").BringToFront
Printdlg.Buttons("Button 3").BringToFront

'Display the dialog box
CurrentSheet.Activate
wsStartSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then

'the following code will print the selected sheets as multiple print jobs.
'continuous page numbers will therefore not be printed

    If Printdlg.Show Then

        For Each CB In Printdlg.CheckBoxes
            If CB.Value = xlOn Then
                Worksheets(CB.Caption).Activate
                ActiveSheet.PrintOut
                'ActiveSheet.PrintPreview 'for debugging
                End If
                Next CB

 'the following code will print the selected sheets as a single print job.
 'This will allow the sheets to be printed with continuous page numbers.

        'If Printdlg.Show Then
                'For Each CB In Printdlg.CheckBoxes
                    'If CB.Value = xlOn Then
                        'Worksheets(CB.Caption).Select Replace:=False
                    'End If
                'Next CB
                'ActiveWindow.SelectedSheets.PrintOut copies:=1
                'ActiveSheet.Select
        Else
            MsgBox "No worksheets selected"
        End If
    'End If

End If

'Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
Printdlg.Delete

'Reactivate original sheet
CurrentSheet.Activate
wsStartSheet.Activate

End Sub

Sub GenerateClientExcelReports()

'1. Declare variables

Dim i As Integer
Dim SheetCount As Integer
Dim TopPos As Integer
Dim lngCheckBoxes As Long, y As Long
Dim intTopPos As Integer, intSheetCount As Integer
Dim intHor As Integer       'this will be for the horizontal position of the items
Dim intWidth As Integer     'this will be for the overall width of the dialog box
Dim intLBLeft As Integer, intLBTop As Integer, intLBHeight As Integer
Dim Printdlg As DialogSheet
Dim CurrentSheet As Worksheet, wsStartSheet As Worksheet
Dim CB As CheckBox

 'Dim wb As Workbook
 'Dim wbNew As Workbook
 'Set wb = ThisWorkbook
 'Workbooks.Add ' Open a new workbook
 'Set wbNew = ActiveWorkbook

On Error Resume Next
Application.ScreenUpdating = False

'2.   Check for protected workbook

If ActiveWorkbook.ProtectStructure Then
    MsgBox "Workbook is protected.", vbCritical
    Exit Sub
End If

'3.   Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set wsStartSheet = ActiveSheet
Set Printdlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

'4.   Add the checkboxes

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
    Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'5.       Skip empty sheets and hidden sheets
    If Application.CountA(CurrentSheet.Cells) <> 0 And _
        CurrentSheet.Visible Then
        SheetCount = SheetCount + 1
        Printdlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            Printdlg.CheckBoxes(SheetCount).Text = _
                CurrentSheet.Name
        TopPos = TopPos + 13
    End If
Next i

'6.   Move the OK and Cancel buttons
Printdlg.Buttons.Left = 240

'7.   Set dialog height, width, and caption
With Printdlg.DialogFrame
    .Height = Application.Max _
        (68, Printdlg.DialogFrame.Top + TopPos - 34)
    .Width = 230
    .Caption = "Select sheets to generate"

End With

'8.   Change tab order of OK and Cancel buttons
'   so the 1st option button will have the focus
Printdlg.Buttons("Button 2").BringToFront
Printdlg.Buttons("Button 3").BringToFront

'9.   Display the dialog box
CurrentSheet.Activate
wsStartSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then


        If Printdlg.Show Then
                For Each CB In Printdlg.CheckBoxes

                    If CB.Value = xlOn Then
                        Worksheets(CB.Caption).Select Replace:=False

                       'For y = 1 To ActiveWorkbook.Worksheets.Count
                            'If WorksheetFunction.IsNumber _
                            '(InStr(1, "ActiveWorkbook.Sheets(y)", "Contents")) = True Then
                                'CB.y = xlOn
                            'End If

                    End If

                Next


                ActiveWindow.SelectedSheets.Copy

        Else
            MsgBox "No worksheets selected"


        End If

End If

'Delete temporary dialog sheet (without a warning)
'Application.DisplayAlerts = False
'Printdlg.Delete

'Reactivate original sheet
'CurrentSheet.Activate
'wsStartSheet.Activate

'10.   Delete temporary dialog sheet (without a warning)

Application.DisplayAlerts = False
Printdlg.Delete

'11.   Reactivate original sheet

CurrentSheet.Activate
wsStartSheet.Activate
Application.DisplayAlerts = True

End Sub

Sub SelectAllCheckBox()
Dim CB As CheckBox

For Each CB In ActiveSheet.CheckBoxes
    If CB.Name <> ActiveSheet.CheckBoxes(1).Text Then
        CB.Value = ActiveSheet.CheckBoxes(1).Value
    End If
Next CB

'ActiveSheet.CheckBoxes("Check Box 1").Value
End Sub

see answer as for problem #1. please add some more info about problem #2: the code you posted has three subs that run independently from each other, so I suppose you're calling any of them by means of some button (a UserForm or ActiveX one): if so which order of calling does generate the crash? — user3598756

user3598756 user3598756 · Accepted Answer · 2016-04-19T10:10:04

as for problem n°1

add a declaration of a boolean variable

Dim firstSelected As Boolean

and then modify the For Each CB In Printdlg.CheckBoxes loop block code as follows

        If CB.Value = xlOn Then
            If firstSelected Then
                Worksheets(CB.Caption).Select Replace:=False
            Else
                Worksheets(CB.Caption).Select
                firstSelected = True
            End If

           'For y = 1 To ActiveWorkbook.Worksheets.Count
                'If WorksheetFunction.IsNumber _
                '(InStr(1, "ActiveWorkbook.Sheets(y)", "Contents")) = True Then
                    'CB.y = xlOn
                'End If
        End If

since there's always an ActiveWorksheet when macro starts and thus if you only use Worksheets(CB.Caption).Select Replace:=False statement you keep adding it to the via Printdlg selected sheets.

Excel/VBA Macros assistance

1 Answers