Hide rows section of code not working with other macro code - excel

I have been trying to have two independent codes change my worksheet based on either a cell value or a data validation selection. To try to highlight what my intent is I have a database of Steel Structural members I am trying to create a worksheet that the end user will select if they want US or Metric Units. Based on that selection I need either row 11 or 12 to be hidden. I already have a macro attached to the worksheet that will enter the user's selection from a data validation list into subsequent columns. To further explain my end goal: Row 11 is the Members in US units and 12 is the Metric Units. If the end user selects US they will not see the Metric Row, and vise versa.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler
Dim rngDV As Range
Dim iCol As Integer
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
If Target.Column = 3 Then
If Target.Value = "" Then GoTo exitHandler
If Target.Validation.Value = True Then
iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 2
Cells(Target.Row, iCol).Value = Target.Value
Else
MsgBox "Invalid entry"
Target.Activate
End If
End If
End If
exitHandler:
Application.EnableEvents = True
If Target.Address = "$AS$7" Then
Rows("11").Hidden = (Target.Value = "Metric")
Rows("12").Hidden = (Target.Value = "US Standard")
End If
End Sub
I had them as two Worksheet_Change events and had a compiler error, and I have tried to break the two programs into individual sub routines ie:
Private Sub Worksheet_Change(ByVal Target As Range)
SelectStructural Target
HideRow Target
End Sub
Sub SelectStructural (ByVal Target As Range)
...
End Sub
Sub HideRow (ByVal Target As Range)
...
End Sub
Where ... is representative of the previouly mentioned code. And in that case as with above the macro which inputs the member into subsequent columns works but not the row hide routine.
Many thanks in advance.

Here is what I would do to fix your problem. I wouldn't have a worksheet_change event for this at all, because every time anyone types a thing, this code will have to run. Have some other place where the user selects US or Metric and when THAT changes, you can have the event go off.
Determine the point where the user enters US or Metric.
Sub MetricCheck_Change(ByVal Target As Range)
Dim userChoice as String
userChoice = LCase(Sheets("Sheet1").Range("A1")) 'Convert a user input to lowercase
If userChoice = "us" Then
Call UsSub
ElseIf userChoice = "metric" Then
Call MetricSub
Else
MsgBox("Neither US or Metric has been selected. Please select to continue.")
End If
End Sub
Have a sub that Shows the US row, and hides the Metric. Just record a macro that does just that, and put it here.
Sub UsSub()
'Show the US Row
'Hide the Metric Row
End Sub
Do the opposite for the Metric Sub
Sub MetricSub
'Hide the US Row
'Show the Metric Row
End Sub

Related

How to use ByVal Target As Range So it applies to multiple cell and is not dependent on previous

The objective of this code is so every time cell E6:E36 changes from "Yes" or to "Enter Non Final Action Taken Date" I want it to run my macro.
It works only when E6 is marked to match the next value. How do I make it so it is not dependent on the previous cells value?
I'm new with VBA so I'm a bit lost. Any help would be greatly appreciated. See current code below:
Private Sub Worksheet_Change(ByVal Target As range)
Application.EnableEvents = False 'pervent triggering another change event
On Error GoTo ERR_HANDLING
If Not Intersect(Target, range("E6:E36")) Is Nothing Then
Select Case range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")
Case "Yes": EnterDate_of_last_Submission
End Select
End If
If Not Intersect(Target, range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")) Is Nothing Then
Select Case range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")
Case "Enter Non Final Action Taken Date": EnterNonFinal_Date
End Select
End If
On Error GoTo 0
ERR_HANDLING:
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContex
End If
End Sub
You need to loop here and compare cell-by-cell, something like the following:
Private Sub Worksheet_Change(ByVal Target As range)
Dim rngToCheck as Range
Set rngToCheck = Intersect(Target, Me.Range("E6:E36"))
If rngToCheck Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim rng as Range
For Each rng in rngToCheck
Select Case rng.Value
Case "Yes"
EnterDate_of_last_Submission
Case "Enter Non Final Action Taken Date"
EnterNonFinal_Date
End Select
Next
SafeExit:
Application.EnableEvents = True
End Sub
Most likely EnterDate_of_last_Submission and EnterNonFinal_Date should be rewritten to take a Range parameter, namely the cell the date is entered in (which it looks like would correspond to rng.Offset(,1) with your current setup.

MS Excel Objects Lock Row based on Value working with Other Object

I have programming, with major help from others, that works great for two separate workbooks. The problem is that I can't seem to have them both work within the same workbook and I don't know why.
We have a large contact database (4800 rows) workbook with a lot of sorting macros. I use the following to allow the user to double-click a cell to select or de-select a contact. This is under the Excel Objects, Sheet1 (MASTER):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("SelectionMaster")) Is Nothing Then Exit Sub
'set Target font tp "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value < "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.Value = "r"
Cancel = True
Exit Sub
End If
If Target.Value = "r" Then
Target.ClearContents 'Sets Target Value = ""
Cancel = True
Exit Sub
End If
End Sub
In another workbook, I tested the following for locking a particular row if an 'X' is placed in Column AZ (end of contact data). This is under the Excel Objects, Sheet1 (Sheet1):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Not Target.Column = 52 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If UCase(Target.Value) = "X" Then
ActiveSheet.Unprotect
Target.EntireRow.Locked = True
ActiveSheet.Protect
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Locked Then
If MsgBox("Row is locked. Do you want to change the value ?", vbYesNo) = vbYes Then
ActiveSheet.Unprotect
Target.EntireRow.Locked = False
Cells(ActiveCell.Row, 52).Value = ""
ActiveSheet.Protect
End If
End If
End Sub
In the Database file, I have certain rows that identify the contact's category that I would like to have locked. All other cells can be changed. If I copy over the 2nd code to the database file, it doesn't work correctly. Instead it locks all of the cells and prompts the message box regardless of an 'X' in Column AZ. Can these two not co-exist or what is this newb doing wrong?

How do I fix non target cells from activating the sub Worksheet_Change(ByVal Target As Range)

My spread sheet has target cells and cells that I want to be able to enter manual data without the Worksheet Change to activate or run. How do I allow these open user cells to be populated without the private sub running??
More information sample code. There are many code sections like this in the same format.
Private sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Intersect(Target, Range("$B$8:$k$9")) Is Nothing Then
GoTo NEXT10
'Application.EnableEvents = False
End If
Application.EnableEvents = True
MsgBox Target.Address
'-------------------------------------------------------------------
'Application.EnableEvents = True
Application.EnableEvents = False
If Target.Address = "$B$8" Then
If Target.Value >= 0 Then
Range("B9") = Range("B8").Value * 42
End If
ElseIf Target.Address = "$B$9" Then
Range("B8") = Range("B9").Value / 42
End If
Application.EnableEvents = True
End Sub
The problem is if I enter, delete value or text in any empty cells on the worksheet, it activates the Worksheet_Change (ByVal Target ....).I use the If Intersect(Target,Range($B8$:$k$8) Is Nothing to bypass the target if no change. This format is used for other target ranges of important. But I do not understand why when any cell is changed the program runs?? Can this be avoid so various manual entries can be performed? For example text notes, labels, etc.
The Next10 is the start of another section of code but with diferent target address. If the target addess indicated is not intersected, it goes the check the next intersection.

Type 13 mismatch error

I'm receiving a type 13 mismatch error with Excel VBA. This script checks two columns and locks cells in a column once a change is made, or doesn't lock it if the user clicks the cell and clicks off without any changes. Line 5 is apparently the culprit. Any help is much appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Union(Range("I:I"), Range("J:J"))
If Intersect(Target, A) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
ActiveSheet.Unprotect Password:="YourPassword"
Target.Locked = True
ActiveSheet.Protect Password:="YourPassword"
End Sub
Target is the cell or cells that have been changed. If Target is more than a single cell (e.g. pasted block of values, etc) then Target does not have a .Value. Add If Target.Count > 1 Then Exit Sub to the top of the code or loop through Target, examining each cell within Target for the .Value.
Example of the latter,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Range("I:I"), Range("J:J"))) Is Nothing Then
On Error GoTo bm_Safe_Exit
ActiveSheet.Unprotect Password:="YourPassword"
Application.EnableEvents = True
Dim ij As Range
For Each ij In Intersect(Target, Union(Range("I:I"), Range("J:J")))
If ij.Value <> "" Then
ij.Locked = True
End If
Next ij
End If
bm_Safe_Exit:
ActiveSheet.Protect Password:="YourPassword"
Application.EnableEvents = True
End Sub
Additionally, it is not considered a 'best practise' to use the ActiveSheet property in a Worksheet_Change event macro.

VBA duplicate value (not using data validation)

I have a question regarding catching a user for entering duplicate values in a sheet. We are unable to use data validation because cut/copy/paste throws out the data validation and allows them to enter the dupe value. I was originally using this code:
Option Explicit
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'******problem when copying entire row and pasting into new row, enables user to paste dupe Box ID #******
'Defining variables in Mailroom
Dim WS As Worksheet, EvalRange As Range
'Range to check for duplicates
Set EvalRange = Worksheets("Mailroom").Range("Box_ID_Number")
'Checking if entered value is in the defined range; also if cell is empty exit macro
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If user enters dupe value in specified range then error message pops up and event is undone
If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
MsgBox Target.Value & " already appears as a Box ID Number. Please enter a unique ID."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub
The code works fine for keeping a user from typing a dupe value in the column for "Box ID Number." The problem I am having is that if the user is to copy a Box ID Number from a column and another cell from a different column, they are able to paste a Dupe Value that the _SheetChange does not catch. When we were first creating the code for this we were disabling cut/copy/paste functions; however, others using the sheet apparently still need that function for other portions of the sheet.
Any ideas?
Assuming that your users actually need to change only one cell at a time, I think the below thing should work (it's only the bottom part of your code):
If Intersect(Target, EvalRange) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'Check if only one cell in "Box_ID_Number" is changed
If Intersect(Target, EvalRange).Count > 1 Then
MsgBox "One cell at a once please."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
If WorksheetFunction.CountIf(EvalRange, Intersect(Target, EvalRange)) > 1 Then
MsgBox Target.Value & " already appears as a Box ID Number. Please enter a unique ID."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
I have removed Or Target.Cells.Count > 1 and instead of CountIf(EvalRange, Target.Value) in my version you see CountIf(EvalRange, Intersect(Target, EvalRange)). IF Intersect(Target, EvalRange)) is not one cell, you would again get Type Mismatch (13) error. Therefore, to prevent it, I've implemented the additional check you see.
#ZygD ! nailed it with Intersect(Target, EvalRange)
Finished code looks like this:
Option Explicit
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Defining variables in Mailroom
Dim WS As Worksheet, EvalRange As Range
'Range to check for duplicates
Set EvalRange = Worksheets("Mailroom").Range("Box_ID_Number")
If Intersect(Target, EvalRange) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'Check if only one cell in Box_ID_Number is changed at a time
If Intersect(Target, EvalRange).Count > 1 Then
MsgBox "Unable to modify greater than 1 Box ID Number at a time. Please select one Box ID Row."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If`
'check for dupe value in Box ID Number Column; if copy and pasting entire row, dupe check still holds
If WorksheetFunction.CountIf(EvalRange, Intersect(Target, EvalRange)) > 1 Then
MsgBox Intersect(Target, EvalRange) & " already appears as a Box ID Number. Please enter a unique ID."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub

Resources