I'd like to combine the two Hide Row Codes, please help!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("Re-Hire Questionnaire").Protect Password:="Testing2022!", UserInterFaceOnly:=True
If Range("B12").Value = False Then
Rows("9:11").EntireRow.Hidden = True
Else
Rows("9:11").EntireRow.Hidden = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("Re-Hire Questionnaire").Protect Password:="Testing2022!", UserInterFaceOnly:=True
If Range("B19").Value = False Then
Rows("16:16").EntireRow.Hidden = True
Else
Rows("16:16").EntireRow.Hidden = False
End If
End Sub
Tried to place them underneath each other but didn't work. I'm a novice btw lol
A Worksheet Selection Change: Hide Rows
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
Dim TargetCells: TargetCells = Array("B12", "B19")
Dim HideRows: HideRows = Array("9:11", "16:16")
Dim tCell As Range, hRows As Range, n As Long, WasSelected As Boolean
For n = LBound(TargetCells) To UBound(TargetCells)
Set tCell = Me.Range(TargetCells(n))
If Not Intersect(tCell, Target) Is Nothing Then
Set hRows = Me.Rows(HideRows(n))
hRows.EntireRow.Hidden = tCell.Value = False
WasSelected = True
End If
Next n
If WasSelected Then
Me.Parent.Sheets("Re-Hire Questionnaire").Protect _
Password:="Testing2022!", UserInterFaceOnly:=True
End If
End Sub
Related
I am needing to prevent a range of rows from being hidden if any of the rows have text in cells in D column.
Private Sub Worksheet_Change(ByVal Target As Range)
Set rRng = Sheet1.Range("D35, D36, D37, D38, D39, D40")
If Target.Row >= 34 And Target.Row <= 40 Then
If IsEmpty("rRng.value") Then
Range("D35:D40").EntireRow.Hidden = False
Else: Range("D35:D40").EntireRow.Hidden = (Range("D34").Value = "")
End If
End If
End Sub
You might need to trigger your hide/unhide from the calculate event too so that any formulas/vba that changes the values also triggers and update. (Im not sure what the intended result is, so the code below isn't a dropin replacement)
Private Sub Worksheet_Calculate()
HideRows
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
HideRows
End Sub
Public Sub HideRows()
Dim R As Range: Set R = Sheet1.Range("D35:D40")
If Excel.WorksheetFunction.CountA(R) > 0 Then
R.EntireRow.Hidden = False
Else
R.EntireRow.Hidden = True
End If
End Sub
Sub SetAValue()
Sheet1.Range("D35").Value = "show"
End Sub
How do I do this change for 3 pairs of separate cells. I know this 1st code works for 1 pair of cells by putting it on two diff worksheets
Private Sub Worksheet_Change(ByVal Target As Range)
Dim p1 As Range, p2 As Range
Set p1 = Range("L268")
Set p2 = Sheets("Calculator").Range("J2")
If Intersect(Target, p1) Is Nothing Then Exit Sub
Application.EnableEvents = False
p2.Value = p1.Value
Application.EnableEvents = True
End Sub
and then this on the other
Private Sub Worksheet_Change(ByVal Target As Range)
Dim p1 As Range, p2 As Range
Set p1 = Range("J2")
Set p2 = Sheets("Proposal Summary").Range("L268")
If Intersect(Target, p1) Is Nothing Then Exit Sub
Application.EnableEvents = False
p2.Value = p1.Value
Application.EnableEvents = True
End Sub`
but how do I add in two other pairs of cells I also want to equal each other?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim p1 As Range, p2 As Range
Dim a1 As Range, a2 As Range
Dim h1 As Range, h2 As Range
Set p1 = Range("J2")
Set p2 = Sheets("Proposal Summary").Range("L268")
Set a1 = Range("J3")
Set a2 = Sheets("Proposal Summary").Range("L271")
Set h1 = Range("J4")
Set h2 = Sheets("Proposal Summary").Range("L274")
If Intersect(Target, p1) Is Nothing Then Exit Sub
p2.Value = p1.Value
If Intersect(Target, a1) Is Nothing Then Exit Sub
a2.Value = a1.Value
If Intersect(Target, h1) Is Nothing Then Exit Sub
h2.Value = h1.Value
Application.EnableEvents = True
End Sub
THANK YOU!!!
If I've read the ranges involved correctly you should be able to combine the whole thing like this.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("J2:J4")) Is Nothing Then
Sheets("Proposal Summary").Range("L268").Offset((Target.Row - 2) * 3).Value = Target.Value
End If
Application.EnableEvents = True
End Sub
If you want this to work the other way, i.e. update the other sheet when a value changes on Proposal Summary you could use this.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("L268, L271, L274")) Is Nothing Then
Sheets("Calculator").Range("J2").Offset((Target.Row - 268) / 3).Value = Target.Value
End If
Application.EnableEvents = True
End Sub
I am trying to have a UserForm GUI so that we can add and subtract from inventory, I have got it so that I can select a worksheet and a row, but I am having trouble adding and subtracting part. Pretty new to VBA and I am not sure how to call that variable and modify it. Any help would be great!! Here is my code in the UserForm:
Option Explicit
Private Sub BTNadd_Click()
End Sub
Private Sub BTNDone_Click()
'This will save and close the GUI'
ThisWorkbook.Save
StgRmGUI.Hide
End Sub
Private Sub BTNrmv_Click()
End Sub
Private Sub ItmNmSlct_Change()
Dim actItm As String
End Sub
Private Sub ItmTypSlct_Change()
'This allows ItmTypSlct to show available wrkshts then will make item show in Item Name box'
With Worksheets(ItmTypSlct.Value)
ItmNmSlct.RowSource = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Address(, , , True)
End With
End Sub
Private Sub NumBox_Change()
Dim NewVal As Integer
NewVal = Val(NumBox.Text)
If NewVal >= SpBtnARNum.Min And _
NewVal <= SpBtnARNum.Max Then _
SpBtnARNum.Value = NewVal
End Sub
Private Sub SpBtnARNum_Change()
NumBox.Text = SpBtnARNum.Value
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
ItmTypSlct.AddItem ws.Name
End If
Next ws
End Sub
An simple example of updating the column B value by the amount in NumBox
Private Sub BTNadd_Click()
Dim r As Long, cell As Range
With ItmNmSlct
r = .ListIndex
If r < 0 Then Exit Sub
' select quatity cell and increment value
Set cell = Range(.RowSource).Cells(r + 1, 2)
cell.Value = cell.Value + NumBox.Value
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rg As Range
Set rg = Intersect(Target, Range("A1:J10"))
If Not rg Is Nothing And Range("V7") = "YES" Then
[RowNo] = ActiveCell.Row
[ColNo] = ActiveCell.Column
End If
End Sub
…
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("V7")) Is Nothing Then
If Target = "NO" Then [AK1:AL1] = 0
End If
End Sub
The above SelectionChange does not work when the sheet is in protect mode. Is there any way to correct this. In protect mode it hangs up on the line that says [RowNo] = ActiveCell.Row. This works correctly when sheet is unprotected.
Like this:
'...
Me.Unprotect 'in a sheet module Me=the sheet
[RowNo] = ActiveCell.Row
[ColNo] = ActiveCell.Column
Me.Protect
'...
I have two VBA functions, but i am unable to call the other from the first function.
Function 1:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
Dim I, J As Integer
For I = 1 To lastRow
If Cells(I, "C").Value = "" Then
MsgBox "Please Enter Business Type Value", vbOKOnly
Exit Sub
End If
Next I
End With
End Sub
And the 2nd function:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, Me.Columns(3)) Is Nothing Then
ActiveSheet.Unprotect
Select Case Target.Value
Case Is = "CNS"
Target.Offset(0, 4).Locked = True
Case Is = "cns"
Target.Offset(0, 4).Locked = True
Case Is = "APL"
Target.Offset(0, 4).Locked = False
Case Is = "apl"
Target.Offset(0, 4).Locked = False
Case Else
MsgBox "Value not covered by the program", vbInformation + vbOKOnly
End Select
ActiveSheet.Protect
Else
End If
Application.EnableEvents = True
End Sub
please help somebody..
thanks in advance..
In the same module you just call nameoffunction
You can make function public
public sub function
But it's a poor (sometime good) solution. You should structure your code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
call modul1.function1 ( Target ) ' As Range)
End sub
Private Sub Worksheet_Change(ByVal Target As Range)
call modul1.function1 ( Target ) ' as range
call modul1.function2 ( Target )
end sub
edit ok ugly way
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
....
call Worksheet_change ( Target)
End sub