VBA "ignoring" or exit sub with "Select All"

[arkusM]

Good day!

I am trying to prevent a out of memory error when all cells as selected.
Basically I am lookinf for a way to test if the user selects all the cells in a sheet. Then if that happen I want to exit the sub.
Basically
IF "Select all" then Exit Sub
But I don;t know what syntax to use for the "select all" part.
I know that cells.select does select all but if I try

If ActiveSheet.Cells.Select is True then Exit Sub

I gets into some strange loop and Excel locks up.

Any pointers?

 

[Colin Legg]

I gets into some strange loop and Excel locks up.

I'm guessing then that you are using the worksheet's selection change event handler?

Try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    If Target.Count = Cells.Count Then
        Exit Sub
    Else
        'do some things here
    End If
 
End Sub

If you are using Excel 2007 take a look at the CountLarge instead.

Hope that helps...

 

[arkusM]

I'm guessing then that you are using the worksheet's selection change event handler?

Try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    If Target.Count = Cells.Count Then
        Exit Sub
    Else
        'do some things here
    End If
 
End Sub

If you are using Excel 2007 take a look at the CountLarge instead.

Hope that helps...

Haha good guess! I tried this and Excel still hangs. I guess it take a while to count all the target cellls. I also tried using = 16777216 and it still hung.

Is there another way?

 

[ossuary]

You could try setting a specific number as the maximum range...

If Target.Cells.Count > 15 Then
    MsgBox("Please select 15 cells or less.")
    Exit Sub
End If

It shouldn't take long for Excel to just identify how many cells are selected, usually it only hangs if it is actually trying to DO something to the selected cells (in theory, anyway! ).

 

[arkusM]

You could try setting a specific number as the maximum range...

If Target.Cells.Count > 15 Then
    MsgBox("Please select 15 cells or less.")
    Exit Sub
End If

It shouldn't take long for Excel to just identify how many cells are selected, usually it only hangs if it is actually trying to DO something to the selected cells (in theory, anyway! ).

I will try it out. Thanks for the suggestion.

 

[Colin Legg]

Hi,

Please can you post the exact code you're using (the entire event handler) and we'll see what we can do?

Cheers

 

[arkusM]

I am trying to adapt this code, the original came from ozgrid, but it didn't have everthing that I wanted. so I have been adding.

The orginal code used this to handle a multi cell selection

 If Target.Cells.Count > 1 Then Exit Sub

But I wanted to know when multile cells where deleted. hence the current itteration. But know I need to exit when everything is selected.


Oops!! This should not be here yet!! Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"

Dim vOldVal, vOldVal2 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean
Dim x As Integer
If Target.Cells.Count > 1 Then
    vOldVal = "Multiple Cell Select"
    vOldVal2 = ""
End If
On Error Resume Next
 
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
    End With
    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
 
    bBold = Target.HasFormula
        With Sheets("Tracker")
            If Not (.Range("A65536") = "") Then
                x = .Range("IV1").End(xlToLeft).Column + 2
            Else
                x = 1
            End If
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If
 
            With .Cells(.Rows.Count, x).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
                  .Offset(0, 3) = "'" & vOldVal2
 
                With .Offset(0, 2)
 
                  If bBold = True Then
                    .ClearComments
                    .AddComment.Text Text:= _
                         "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                            "Bold values are the results of formulas"
                  End If
                    .Value = Target
                    .Font.Bold = bBold
 
                End With
 
                .Offset(0, 5) = Time
                .Offset(0, 6) = Date
                .Offset(0, 7) = Application.UserName
                .Offset(0, 4) = "'" & Target.Formula
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
 
        End With
 
    vOldVal = vbNullString
 
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    vOldVal = Target
    vOldVal2 = Target.Formula
End Sub

 

[Colin Legg]

I've taken out some of the bells and whistles.
Does this do what you want? **I haven't had time to go through it's logic thoroughly....

This code goes in the ThisWorkbook class module:

Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo ErrorHandler
    
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
    End With
    
        
    With Sheets("Tracker")
            
        '.Unprotect Password:="Secret"
        If LenB(.Range("A1").Value) = 0 Then
            .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                    "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
        End If
 
        
        With .Cells(.Rows.Count, "a").End(xlUp).Offset(1)
        
            .Value = sOldAddress
            
            .Offset(0, 1).Value = vOldValue
            .Offset(0, 3).Value = sOldFormula
            
            If Target.Count = 1 Then
                .Offset(0, 2).Value = Target.Value
                
                If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
            End If
 
            .Offset(0, 5) = Time
            .Offset(0, 6) = Date
            .Offset(0, 7) = Application.UserName
        End With
        
        .Cells.Columns.AutoFit
        '.Protect Password:="Secret"
 
        End With
ErrorExit:
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
    Exit Sub
ErrorHandler:
    'any error handling you want
    
    Resume ErrorExit
    
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    With Target
        sOldAddress = .Address(external:=True)
        
        If .Count > 1 Then
        
            vOldValue = "Multiple Cell Select"
            sOldFormula = vbNullString
        
        Else
        
            vOldValue = .Value
            If .HasFormula Then
                sOldFormula = "'" & Target.Formula
            Else
                sOldFormula = vbNullString
            End If
        End If
    End With
End Sub

 

[arkusM]

Wow. I was not expecting you to re-write the sub!!
I quickly went through it and it seems to work.
I will go through with a fine tooth comb and figure out what you did.
But, I am very gratefull that you took so much time with this.
Looks like I have some more tools to use in the future.
It was WAY, way beyond my expectation. Thank you.

Mark

 

[Colin Legg]

It's no problem - it's not re-written from scratch, I just moved a few things around. Fingers crossed that it works - I may have overlooked something so don't hesitate to post back if there's an issue.

Btw - when I'm picking up code from somewhere on the web, I'm always a bit hesitant if it's a long procedure covered by an 'On Error Resume Next' statement.