Activate sheet when clicking on cell based on cell value - excel

I was attempting to set up a way to jump to sheets in the same workbook by clicking on a cell and activating the sheet with the same value. My code works when the cell value is text. However, it does not work when the value is a number. The majority (99%) of the sheets will be only numbers (6 digits) for the sheet name. An example of a sheet name would be 110110. Here is my code I used:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B4:B800")) Is Nothing Then
If Target.Value <> "" Then
Sheets(Target.Value).Activate
End If
End If
End If
End Sub
I receive:
Run-time error '9':
Subscript out of range
whenever I click on the

In Excel, you can refer to a sheet by the name or index.
In your case, you are referring by index (number) that does not exist in the Excel.
You can simple convert the number to string by using CStr():
Sheets(CStr(Target.Value)).Activate

Related

Intersect Method encountering type mismatch #13 copying and pasting a row

I want to use the intersect method with worksheet change function.
VBA code for a particular worksheet:
Private Sub worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B1:B10")) Is Nothing Then
If Target = "XYZ pty ltd" or Target = "HXH Corporate" Then
msgbox Target
End If
End If
End Sub
The code works when I copy and paste a new value in a cell within the target set.
An error prompt (#13 type mismatch) appears when I copy and paste a row (e.g. A1 through C1) of data over in the target sheet.
a) Intersect is a function that gives all cells that are part of two ranges. It is often used to check if a specific cell is within a range (in your case B1:B10). The function returns Nothing if the ranges have no cell in common, and combined with the Not-operator, the If-statement will be true if they have cells in common.
b) Using Target as you do in If Target = "XYZ pty ltd" is a shortcut for If Target.Value = "XYZ pty ltd". That means VBA will read the content of the cell and compare it against a string. This can fail for 2 reasons, both giving the runtime error 13: (1) When the range contains more that one cell (because Target.Value is now an array of values and in VBA, you can't compare an array with a single value in one go), and (2) if VBA cannot convert the content of a cell into a string - that's the case if a cell contains an Error (#NA, #NAME?...)
Your event routine gets Target as parameter, that is a Range containing all cells that where modified. You will need to loop over all cells individually:
Option Explicit
Private Sub worksheet_change(ByVal Target As Range)
If Intersect(Target, Range("B1:B10")) Is Nothing Then Exit Sub
Dim cell As Range
' Check only cells that are relevant
For Each cell In Intersect(Target, Range("B1:B10"))
If Not IsError(cell.Value) Then
If Target = "XYZ pty ltd" Or Target = "HXH Corporate" Then
' ... (do your magic here)
End If
End If
End If
End Sub

Add a Value Automatically to a Cell Based on Another Cell

I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)
To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.

Excel VBA Clear indirect dropdown cell within a column range

I have successfully used the code below to clear the contents of an indirect cell based on a change of a dropdown list in order to prevent mismatched data.
For example my first drop down cell is D2 and has 3 options, when an option is selected, my second cell F2 (based on named ranges) changes to show the choices specific to the selected option.
When a user changes the first option in D2, the code triggers and clears out the contents of F2 so a new selection can be made preventing mis-matched data.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'Clear Adjustment Reasons if there is a change of Type'
If Target.Address = "$D$2" Then
If Target.Validation.Type = "$F$2" Then
Application.EnableEvents = False
Target.Offset(0, 2).ClearContents
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
What i'm looking to do is now extend this so it can work on a sheet where the dropdown lists will be in each cell of a column (ranged from M7:M500), and the indirect dropdown in each cell of (ranged from N7:N500)
So, when the user changes the original option in any of the cells in the M range, then the corresponding N cell in the same row will clear.
Does anyone know any examples i could potentially look at to make this work?

How to prevent pasting over validation drop down cell in Excel VBA

I need to stop the user from pasting over my validation drop down cell. I have read and tried various solutions, none of which work just right. This code I have checks if the pasted value follows validation rules, but it doesn't work if the entire cell is pasted over my validation cell (it seems that this event fires after the paste, so the validation gets erased together with the previous cell):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Range("D2:F13")
If Not Cell.Validation.Value Then
MsgBox "Value violates validation rule"
Application.Undo
Exit Sub
End If
Next
Ideally the code would check if the value of the cell that's being pasted matches validation dropdown options and only allows to paste the value (not the formatting) into the cell.
Thanks!
You can disable the Cut\Copy in the specific cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' TARGET IS YOUR VALIDATION CELL
If Target.Column = 1 And Target.Row = 1 Then
Application.CutCopyMode = False
End If
End Sub
Or more complex you can try to check the clipboard of the user on SelectionChange
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' TARGET IS YOUR VALIDATION CELL
If Target.Column = 1 And Target.Row = 1 Then
Set MyData = New DataObject
MyData.GetFromClipboard
'In MyData.GetText you have the clipboard data in text format
If MyData.GetText <> "what you want" then
'...
End if
End If
End Sub
In this case you must add a reference to Microsoft Forms 2.0 Object Library. You can find it in this path: C:\Windows\System32\FM20.DLL

Select first empty cell in specific column when switching between worksheets

I have a single workbook with multiple sheets. Sheet 1 uses cell A1 as a search box to find a specific sheet in the book. The sheets after Sheet 1 are named like this, SO123456 with different numbers following the SO. I have the following code on sheet 1 to open the corresponding sheet from the value typed into A1 of Sheet 1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
End Sub
When the corresponding sheet is opened, I want to open it to the next empty cell in column A. I have some code on the SOxxxxxx sheets that populates time in Column C when my data is entered in Column A. Here is that code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then
Target.Offset(0, 2).Value = Now
End If
End Sub
I'm not sure how to make sure the first empty cell in Column A is selected or where the code goes; sheet being opened or where the call is to open the sheet. I tried entering the following code below the Worksheet_Change block with no luck:
Range("A" & Rows.Count).End(xlup).Offset(1).Row
Cells(Rows.Count,1).End(xlup).Offset(1).Row
UsedRange.Rows.Count
I know next to nothing about VBA if you haven't already noticed.
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "A$1” Then Exit Sub
With WorkSheets(Target.Value)
.Activate
.Cells(.Rows.Count,1).End(xlup).Offset(1).Select
End With
End Sub
This should get you to the first empty cell in Column A
rowEmpty = Range("A" & 10000).End(xlup).Row +1
You can replace the number 10000 with a sufficiently large number that ensures there will be no data there. There are alternatives to that, but I think this one is easier to begin with.
With this code, typing a sheet name in cell A1 from sheet1 will activate the sheet you type, and the active cell will be the first one in blank in column A.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
ActiveSheet.Cells(Sheets(Target.Value).Range("A1").End(xlDown).Row + 1, 1).Select
End Sub

Resources