Conflict between macro and workbook sheet change

[cdfjdk]

I am getting a conflict between a macro and a workbook sheet change. Both work correctly individually, but the combination is giving run-time error 6 Overflow

The macro:
1. Cleans sheet "Combined".
2. Loops through worksheets - copy CurrentRegion and paste as values in "Combined".

The workbook sheet change enables multiple selections from 3 columns with data validation.

When I run the macro it performs step 1 (cleans sheet "Combined"), presumably copies from the first sheet (only 20 rows in test), but then gives run-time error 6 Overflow at the start of the workbook sheet change (at If Target.Count > 1 Then Exit Sub).

Any suggestions as to a fix?

Macro

Sub CombineSheets()


Dim Sh As Worksheet
On Error Resume Next


    Sheets("Combined").Select
    Rows("2:" & Rows.Count).ClearContents


For Each Sh In ThisWorkbook.Worksheets


    If Sh.Name <> "Awards_funds_201801" And Sh.Name <> "Outcomes and Outputs" And Sh.Name <> "GSM export 20180116" _
        And Sh.Name <> "Deliverables" And Sh.Name <> "Tasks" And Sh.Name <> "Lists" _
        And Sh.Name <> "Combined" And Sh.Name <> "Master" Then


            Sh.Activate
            Range("A1").Select
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy
            Sheets("Combined").Select
            Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues


    End If
Next Sh
End Sub

Workbook_SheetChange

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


    Dim Brng As Range
    Dim Grng As Range
    Dim Rrng As Range
    Dim rngCols As Range
    Dim FirstVal As String
    Dim NextVal As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next


    Set Brng = Range("B:B").SpecialCells(xlCellTypeAllValidation)
    Set Grng = Range("G:G").SpecialCells(xlCellTypeAllValidation)
    Set Rrng = Range("R:R").SpecialCells(xlCellTypeAllValidation)
    Set rngCols = Union(Brng, Grng, Rrng)
    
    If rngCols Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
        'Column B - multiple selection if condition FirstVal = Intercountry is met
        If Not Intersect(Target, Brng) Is Nothing Then
            NextVal = Target.Value
            Application.Undo
            FirstVal = Target.Value
            Target.Value = NextVal
                If Not NextVal = "" And Left(FirstVal, 12) = "Intercountry" Then
                    Target.Value = IIf(FirstVal = "", NextVal, FirstVal & ", " & NextVal)
                End If
        End If
        
        'Column G - multiple selection
        If Not Intersect(Target, Grng) Is Nothing Then
            NextVal = Target.Value
            Application.Undo
            FirstVal = Target.Value
            Target.Value = NextVal
            If FirstVal <> "" Then
                If NextVal <> "" Then
                    If FirstVal = NextVal Or _
                       InStr(1, FirstVal, ", " & NextVal) Or _
                       InStr(1, FirstVal, NextVal & ",") Then
                        Target.Value = FirstVal
                    Else
                        Target.Value = FirstVal & ", " & NextVal
                End If
            End If
        End If
        End If
        
        'Column R - multiple selection
        If Not Intersect(Target, Rrng) Is Nothing Then
            NextVal = Target.Value
            Application.Undo
            FirstVal = Target.Value
            Target.Value = NextVal
            If FirstVal <> "" Then
                If NextVal <> "" Then
                    If FirstVal = NextVal Or _
                       InStr(1, FirstVal, ", " & NextVal) Or _
                       InStr(1, FirstVal, NextVal & ",") Then
                        Target.Value = FirstVal
                    Else
                        Target.Value = FirstVal & ", " & NextVal
                End If
            End If
        End If


    End If
    Application.EnableEvents = True
        
End Sub

 

[Joe4]

Your Macro is triggering the Workbook_SheetChange to run. Do you need this Event Procedure code to run as the Macro is running? If not, then disable events temporarily while your Macro is running.
Do that by putting this line at the top of your code:

Application.EnableEvents = False

Just be sure to turn it back on at the end of your code, like this:

Application.EnableEvents = True

or else your Workbook_SheetChange event procedure will not be called when you are making manual changes!

 

[Fluff]

Change this

If Target.Count > 1 Then Exit Sub

to

If Target.CountLarge > 1 Then Exit Sub

Will get rid of the error, but the better option is to Disable/Enable events at the beginning & end of the macro

 

[cdfjdk]

Brilliant! And so fast! Application.EnableEvents = False fixed it immediately.
Many thanks!

 

[Joe4]

You are welcome!

Just make sure that you turn it back on at the end of the code, and be aware of one thing.
If you code gets interrupted so that the events are disabled and not re-enabled, you will need to do something manual to re-enable the events.
There are two main ways of doing this:
1. Close out of Excel and re-starting it
2. Run the following one-line VBA code:

Sub ReEnableEvents()
    Application.EnableEvents = True
End Sub

I have seen it happen many times where people are testing, and then wonder why their code doesn't seem to be running. A lot of times, they were stepping through the code, and exited before the Re-Enable line.
So if that code doesn't seem to be running, try running the short code above.

 

[cdfjdk]

Thanks again for the warning. This has been a great learning experience for me, so it's helpful to get that detail as well!

The macro will only ever run as a workbook open event, so I guess it's unlikely to be interrupted.

 

[Joe4]

The macro will only ever run as a workbook open event, so I guess it's unlikely to be interrupted.

OK. Then the most likely situation where it would arise is if the code experiences errors when running and doesn't complete (and you would usually know because you will get error messages on your screen).

 

[cdfjdk]

Which might be a bit of scary during an open event...