Select range based on number entered in any cell - vba

So far I have gotten the VBA code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value > 0 Then Target.Resize(, Application.Min(400, 2 * Target.Value)).Select
End Sub
This does what I want; Selects a range based on a number (*2, with a max limit of 400 cells selected) that I write anywhere in my workbook. The problem that I need help with is that i get a runtime-error 13 if I type something (Text) or delete something. Any idea on how I can modify this code would be greatly appreciated.
//Chris

You need to prevent your next actions from re-triggering the same macro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value > 0 Then
Target.Resize(, Application.Min(400, 2 * Target.Value)).Select
End If
End Sub

This is the VBA I ended up with.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Error_handler:
If Val(Target.Cells(1).Value) > 0 Then Target.Resize(, Application.Min(400, 2 * Target.Value)).Select
Exit Sub
Error_handler:
MsgBox "Error Handler"
End Sub
This will select the range specified by the cell value and also allow for text and other editing to be made as well as handling eventual errors by showing the MsgBox "Error Handler"

Related

Why am I getting a type mismatch error here?

I create a new module and insert this code:
Sub test()
Set wsData = ThisWorkbook.Worksheets("Data")
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count
msgbox sCount
End Sub
In the worksheet "Data", I have this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
'code
End if
End if
End Sub
When I run the test() sub, I get a type mismatch error on If Not Intersect(Target, Range("K:M")) Is Nothing, as Target wrong type.
Why this is happening?
Why is test triggering the Change Event?
I dont get the same error if manually filter column 14 of my Data sheet to leave only the blank cells!
The problem with the type mismatch, is that the Target.Cells is more than one cell. Thus, the Target.Value <> "" throws type mismatch, because multiple cells cannot be compared to "". See the MsgbBox with the number of cells:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Target.Cells.CountLarge > 1 Then MsgBox Target.Cells.CountLarge
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
'code
End If
End If
End Sub
Based on the business logic there could be several solutions.
The easiest one is to write
If Target.Cells.CountLarge > 1 Then Exit Sub in the _SelectionChange event.
Another way is to disable events around
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count like this:
Sub TestMe()
Set wsData = ThisWorkbook.Worksheets("Data")
Application.EnableEvents = False
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count
Application.EnableEvents = True
msgbox sCount
End Sub
I almost closed this question as a duplicate.
I will answer both your questions but in the reverse order so that you can understand it better.
Why is test triggering the Change Event?
I have explained it in SpecialCells causing SheetSelectionChange event in Excel 2010
When I run the test() sub, I get a type mismatch error on If Not Intersect(Target, Range("K:M")) Is Nothing, as Target wrong type.
Why this is happening?
When the procedure Test triggers the Worksheet_SelectionChange event, your code will fail on the line
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
It is because Target.Value <> "" is the culprit as SpecialCells(xlCellTypeBlanks).Count may return multiple cells.
If you break the above line in 2 lines then you will not get an error
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("K:M")) Is Nothing Then
If Target.Value <> "" Then
'code
End If
End If
End Sub

Select specific cell after Inputting values In previous cells

so I have an input sheet and want to move the activated cell to another cell after data has been typed in/chosen.
So far I've got this:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Range("F11").Value <> "" Then
Range("F13").Select
End If
End Sub
But the problem is this does not seem to work with more cells and ranges for some reason. So for example if then F13 is selected I want to move to F16. If F16 is selected I want to move to F17. So no rule here like always 2 rows down. How can I solve this?
Best
This is a simply type of a boilerplate, which can be increased further, following a specific business logic.
If you want to Add Range("D5") with 3 rows, then add it to the Union in this line: If Intersect(Target, Union(Range("F16"), Range("F13"))) and then make a Case Range("D5").
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row > Rows.Count - 2 Then Exit Sub
If Target = vbNullString Then Exit Sub
If Intersect(Target, Union(Range("F16"), Range("F13"))) Is Nothing Then Exit Sub
Select Case Target
Case Range("F16")
Target.Offset(1).Select
Case Range("F13")
Target.Offset(2).Select
End Select
End Sub

VBA - Open a msgbox when cell value = 1

I need help with a very basic vba macro. When the value in A6 is equal 1 a msgbox needs to appear in the workstation. I developed the below code but the problem is that when I add any other information in the spreadsheet (for example, if I write "i love pizza" in B6) the msgbox will prompt again and I need it to prompt just one time, just when I set the value of A6 = 1. Could you please help me?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A6").Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End Sub
#edit
I forgot one very important thing... the value "1" is getted with a VLOOKUP so its not insert manually by the user, i'm sorry about this. I tried the codes you people answered and it worked just when I put the vlue manually and as I said in the edit start, the value is set with a VLOOKUP. Any other tips, please?
You need to check if the change is due to the cell A6 being changed, rather than a different cell.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row = 6 Then
If Target.Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End If
End Sub
You can use this code instead of the previous one
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Me.Range("A6").Address And Me.Range("A6").Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End Sub
Target is the changed cell in Excel. so for every change event, I check if the target is Range("A6").
Pertaining to the statment : and I need it to prompt just one time, you need to save the oldvalue. So the prompt is displayed only once, when you set the value to 1. If A6 is already 1 and then you type 1 again, no prompt.
Option Explicit
Dim oldVal
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Address = "$A$6") Then
If Target.Value = 1 And Target.Value <> oldVal Then
oldVal = Target.Value
MsgBox "Test"
End If
End If
End Sub
You need to check inside the Worksheet_Change event, that only if Cell "A6" is pressed, then continue. And afterwards, check if the value of the cell equals 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Target.Value = 1 Then MsgBox "THIS IS A MSGBOX."
End If
End Sub
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$6" Then
If Target.Value = 1 Then
MsgBox "THIS IS A MSGBOX."
End If
End If
End Sub
I forgot one very important thing... the value "1" is getted with a VLOOKUP so its not insert manually by the user, i'm sorry about this. I tried the codes you people answered and it worked just when I put the vlue manually and as I said in the edit start, the value is set with a VLOOKUP. Any other tips, please?

VBA - Open a UserForm by clicking anywhere in a specific column

I would like to build a makro in VBA which opens a UserForm when I click in a cell in a specific column, for more details look here.
With this code (from Mr.Burns):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
'name of userform .Show
End If
End If
End Sub
I was able to open the UserForm by clicking in the cell A1, but not by clicking in any cell inside the column A.
I tried to solve this problem with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
Dim check As Boolean
check = True
If check Then
Dim i As Long
For i = 1 To 100000
If Not Intersect(Target, Range("A" & i)) Is Nothing Then
UserForm1.Show
check = False
End If
Next
End If
End If
End Sub
It actually works fine, but it is very slow, is there any better possibility to solve this?
To display the form when a cell is selected in column A:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if target is one cell and in column A
If Target.Columns.count = 1 And Target.Rows.count = 1 And Target.Column = 1 Then
UserForm1.Show
End If
End Sub
You can use .count and .column property together with AND and it will become so much simple and fast. Following code triggers pop-up if u click in column A on active-sheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errorhandler
If Target.Count = 1 And Target.Column = 1 Then '.count to check if only one cell is selected and .column to check if it is a first column
'UserForm1.Show
'Do whatever you want to do here like opening User form
MsgBox "You clicked in column A"
End If
errorhandler:
End Sub

Selection.Count overflow when selecting all cells

In Excel 2007 I want to prompt a message when a cell (L2) is clicked on. I have a piece of code that works but the problem is that when I select all the cells in the sheet with Ctrl+A I get error number 06: overflow on the line If Selection.Count = 1 Then
Mandatory VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Easily fixed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, CStr(Target.Address), ":") < 1 Then
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End If
End Sub
You must change your code as follows. No Error-Traps needed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Area.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
If you had 64-bit Excel I would tell you to use CountLarge instead of Count. Excel 2007 only comes in the 32-bit variety so that's not an option for you.
Your problem is that Range.Count returns a Long variable and throws an error if the number of cells is greater than a Long can store.
To get around this, you can do the following:
Use a Decimal data type stored inside a Variant. The combination can count more than the 1,048,576 rows x 16,384 columns of cells in an Excel worksheet.
Count the cells one column at a time to avoid the error with Range.Count.
I wrote a function that does that. Save this function in a regular code module (not a Worksheet or Workbook module) and use it like this:
If CountLarge32(Selection) = 1 Then
Here's the actual function:
Public Function CountLarge32(ByVal rangeOrSelection As Variant) As Variant
Dim target As Excel.Range
On Error Resume Next
Set target = rangeOrSelection
On Error GoTo 0
Dim cnt As Variant
Dim iColumn As Excel.Range
If Not target Is Nothing Then ' parameter -IS- a valid Range
' Use Range.Count on one column at a time to avoid the overflow error
' if counting higher than the limit of the Long data type.
For Each iColumn In target.Columns
cnt = CDec(cnt + iColumn.Cells.Count)
Next iColumn
CountLarge32 = cnt
End If
End Function
This function also avoids the error that occurs if Select is an object (e.g. button, shape, chart, etc.) instead of a cell.