Check a range is not the entire sheet? - vba

I have this function which is trying to detect when a particular cell value changes. The problem is, if the user selects the whole spreadsheet and presses delete, I get an overflow in my check that the range is only a single cell:
Public Sub Worksheet_Change(ByVal Target As Range)
'Overflow can occur here if range = whole spreadsheet
If Not IsError(Int(Target.Cells.Count)) Then
If Target.Cells.Count = 1 Then
If Target.Cells.Row = 4 And Target.Cells.Column = 1 Then
Sheets("X").Cells(5, 1).Calculate
End If
End If
End If
End Sub
Is there a more elegant way that I can get this code to only run, when a single particular cell value is changed? (with no overflows, problems when I clear the whole worksheet etc)?

I'm assuming you are on Excel 2007+ since the number of rows and columns increased dramatically in those versions. You might have better luck checking to make sure both the row and column count = 1, since those maxes will be much lower than the product of the two (ie, the cell count):
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then

Use CountLarge instead of Count
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If target.Cells.CountLarge > 1 Then Exit Sub
'Code...
End Sub
See: MSDN Range.CountLarge Property (Excel)

Related

VBA - Select Top of Matrix

I'm using a "worksheet_selectionChange" event to fire a macro whenever a cells within certain ranges are selected.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Cells.Offset(-???,0).Value
Case "LABEL_1"
Tenor = "2W"
Call MyLameMacro()
Case....
End Select
End Sub
Those ranges look like little matricies:
If the user selects any of the cells underneath label, I want VBA to lookup whatever the label is at the top. Using offset would work if I knew exactly how many rows up to Label, but its not constant....
Is there another way to go about that?
Thanks - KC
Barring further information about the layout ... you can use formatting to build your own search algorithm. This will slow down if it has to go through thousands of lines (find another way if your data set is that large).
You'll have to replace "labelColor" and "notLabel" with the background color of the label rows. This is assuming the above picture is accurate, and "Label" is highlighted. To find the value to replace them with, simply select the cell in question, then type "debug.print selection.interior.color" into the immediate window in VBA.
By placing the label value and the origin address in parentheses after your lame macro, you can preserve those values in the macro.
I did not test this. In order to do so I would have to guess at the setup of your workbook ... but an approximation of this code should work for you.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
i = 0
searchLoop:
If i > 100 Then
MsgBox ("Infinite loop. Click OK to stop")
Exit Sub
End If
If Target.Offset([-i], 0).Interior.Color = labelColor Then Call MyLameMacro(Target.Offset([-i], 0), Target.address)
If Target.Offset([-i], 0).Interior.Color = notLabel Then
If Target.Offset([-i], 0).Value = "Value" Then Call MyLameMacro(Target.Offset([-i], [-1]).Value, Target.address)
i = i + 1
GoTo searchLoop
End If
End Sub

Dynamically, continously, set a cell's value according to ActiveCell's value (which is on another worksheet)

I have a workbook with a two sheets, Rep and Aux.
I want to dynamically set Aux!A2 to the value of the ActiveCell, which is on sheet Rep, but only if the ActiveCell is on column D of that sheet (in the range Rep!D2:D5000).
To top it all of I need this mechanism to run as long as the workbook is active, not just a one-shot.
For example: While being on sheet Rep I place the cursor, i.e. ActiveCell on cell D2. I expect Aux!A2 to be set to the value of Rep!D2. I move the cursor to, say, Rep!F5 and expect nothing to happen to Aux!A2, lastly, I activate cell Rep!D7 and again, expect Aux!A2 to get the ActiveCell's value. Continue till I close the workbook.
My VBA skills are non-existent and Googling, the only thing remotely close to what I described was:
Sub Macro1()
If Not Intersect(ActiveCell, Sheets("Rep").Range("D2:D5000")) Is Nothing Then Sheets("Aux").Range("A2").Value = ActiveCell.Value
End Sub
Which fails completely.
Put this in the code of the "Rep" worksheet. Triggers anytime a cell is selected on that sheet, if the cell is in column 4 (D) then it sets the value of the cell on Aux to match.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
End If
End Sub
EDIT: In response to comments.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub
This subroutine is an event that exists on every worksheet. Any time a selection changes it will run any code you put in it. The "ByVal Target as Excel.Range" part is saying it's giving you a copy of the target range being selected, because you could select more then one cell.
If Target.Column = 4 Then
end if
This is an If Block. If the condition is true, any code between the "Then" and the "End If" will execute. The condition is if the target's column is 4 in this case.
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
This sets the cell at row 2 column 1 value to match the value of the target that was selected.
Now that I think about it I wonder what this code will do if you select a range of cells.....

Filtering data in another worksheet using multiple non-contiguous cell values

I've looked around for the past few days to find an answer to this, but haven't found anything that refers to all aspects of my query. I'm hoping that somebody here can help me/point me in the right direction!
Essentially, I have a Store List and a Customer list (with the store each customer has visited) in two different sheets within one workbook, comprising a one to many relationship. I want to be able to filter the Customer List dynamically by selecting stores in the Store List, although have only managed to filter by one value (Store) so far, using the below code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then
Sheet2.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=ActiveCell.Value
Sheet2.Activate
End If
End Sub
Though this is, of course, only a solution for when one store needs to be selected. Should I need to make a non-contiguous selection of cells, how would I go around this?
Any help would be greatly appreciated!
My way to do it would be to handle multiple selections. The code looks like shown bellow (TblCustomer is your "Table1"):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rgSel As Range, rgCell As Range
Dim cellsFound As Integer
Dim filters() As String
Set rgSel = Selection
cellsFound = 0
For Each rgCell In rgSel
If rgCell.Column = 1 Then
cellsFound = cellsFound + 1
ReDim Preserve filters(cellsFound)
filters(cellsFound - 1) = rgCell
End If
Next rgCell
If cellsFound > 0 Then
Sheet2.ListObjects("TblCustomers").Range.AutoFilter Field:=1, Criteria1:=filters, Operator:=xlFilterValues
'you may need to select the customer sheet manually after you made your multiple selection,
'otherwise you'll just jump to it avery time you change the selection
'Sheet2.Activate
End If
End Sub

Excel-VBA - How to identify Target range (more than 1 cell) is deleted in a Worksheet_Change function?

I am trying to find if a user deletes values in certain cells in column B then cells in same rows in column X are also deleted using worksheet_change function.
When I delete only one cell in column B then IsEmpty(Target) returns true and I am able to clear the same row cell in column X.
However, when select multiple cells in column B and press delete button, the IsEmpty(Target) returns False. Now here Target is range of multiple cells. I just can't find a way to find if a user has deleted range of values in column B at the same time. Any help would be much appreciated.
Below code works when one cell is deleted but not when a range of cells are deleted.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
If IsEmpty(Target) Then
Application.EnableEvents = False
ActiveSheet.Range("X" & Target.Row & ":X" & Target.Row + Target.Rows.Count - 1).ClearContents
Application.EnableEvents = True
End If
End Sub
Thanks
Uttam
You misunderstand the purpose of the function IsEmpty.
I guess what you are really looking for are cells which do not contain a value (blank cells). The following line will give you the count of cells which contain a value. If that is equal to zero then they are all blank.
Target.SpecialCells(xlCellTypeConstants).Count
Yet, the above line of code will result in an error if all cells are empty. Hence, you will have to adjust your code as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
Dim bolIsEmpty As Boolean
On Error GoTo AllAreEmpty
bolIsEmpty = Target.SpecialCells(xlCellTypeConstants).Count = 0
On Error GoTo 0
If bolIsEmpty Then
' ... your code here ...
End If
Exit Sub
AllAreEmpty:
bolIsEmpty = True
Resume Next
End Sub
Copy the column in question into a hidden worksheet (workSheet.Visible = xlVeryHidden), then use WorksheetFunction.CountA to compare the number of non-empty cells in the column of the visible worksheet and in the 'shadow' column of the hidden worksheet. This will quickly inform you if the number of cells with contents has decreased (i.e., contents have been deleted).
If so, get the .UsedRange of the observed column, find the first empty cell in it and check if the corresponding cell in the shadow column is empty as well. If yes, continue to the next empty cell; if not, you know the cell content has been deleted, and you can delete the corresponding cell content in your 'column X'.
After each Worksheet_Change event you need to make another 'shadow' copy.

Target.count causing an Overflow error

I have Worksheet_SelectionChange function. In the first line I wanted to condition that if more than 1 cell is selected then exit.
I wrote:
If Target.Cells.Count > 1 Then Exit Sub
However, when I select the whole worksheet, I get an error message:
"Run time error 6 - Overflow"
It seems like Target.Count can't handle such large numbers ?
What can I do to get around this?
Replace Count with CountLarge.
Documentation: http://msdn.microsoft.com/en-us/library/office/ff196838(v=office.15).aspx
The CountLarge property is functionally the same as the Count property, except that the Count property will generate an overflow error if the specified range has more than 2,147,483,647 cells (one less than 2048 columns). The CountLarge property, however, can handle ranges up to the maximum size for a worksheet, which is 17,179,869,184 cells.
Break the check into rows and columns. This way, the count encounters a maximum of "only" 1,048,576 (rows) as opposed to 17,142,120,448 cells.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Count > 1 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
' do stuff
End Sub