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

arkusM

Well-known Member
Joined
Apr 12, 2007
Messages
560
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

Code:
If ActiveSheet.Cells.Select is True then Exit Sub
I gets into some strange loop and Excel locks up.

Any pointers?
 

Colin Legg

MrExcel MVP, Like totally RAD man
Joined
Feb 28, 2008
Messages
3,497
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:
Code:
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

Well-known Member
Joined
Apr 12, 2007
Messages
560
I'm guessing then that you are using the worksheet's selection change event handler?

Try this:
Code:
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

Active Member
Joined
Sep 5, 2004
Messages
279
You could try setting a specific number as the maximum range...

Code:
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

Well-known Member
Joined
Apr 12, 2007
Messages
560
You could try setting a specific number as the maximum range...

Code:
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

MrExcel MVP, Like totally RAD man
Joined
Feb 28, 2008
Messages
3,497
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

Well-known Member
Joined
Apr 12, 2007
Messages
560
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
Code:
 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"

Code:
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
 
Last edited:

Colin Legg

MrExcel MVP, Like totally RAD man
Joined
Feb 28, 2008
Messages
3,497
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:
Code:
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

Well-known Member
Joined
Apr 12, 2007
Messages
560
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

MrExcel MVP, Like totally RAD man
Joined
Feb 28, 2008
Messages
3,497
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.
 
Last edited:

Forum statistics

Threads
1,082,269
Messages
5,364,148
Members
400,783
Latest member
sambills

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top