I have VBA to hide columns based on a list drop down and an activeX check box. When the check box is selected or unselected the code for the columns visibilty doesn't rerun unless you change the dropdown selection a second time. How would I get it to detect checkbox change and refresh?
The dropdown has this code but the checkbox has no code yet.
The dropdown is to select a type of formatted sheet so that when it is selcted only those columns will show. When the checkbox is checked and a type is chosen from the dropdown then only those related columns will show.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$11" Then
If Target.Value = "A" Or Target.Value = "B" Then
Sheets("Worksheet").Columns("BL:CH").Hidden = True
ElseIf Target.Value = "C" And Not Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = False
ElseIf Target.Value = "C" And Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = True
Sheets("Worksheet").Columns("BZ:CH").Hidden = False
End If
End If
End Sub
This is the code I have on the CheckBox as a workaround for the moment.
The checkBox and Dropdown are in one sheet and the columns being
hidden are in another sheet.
Sub CheckBox1_Click()
If CheckBox1.Value = True Then
MsgBox "Reselect A"
Else
MsgBox "Reselect A, B or C"
End If
End Sub
Related
I wanted to make a checkbox, calling a macro that hides and unhides columns on Excel worksheet with specific value in cell, but it is not working
I tried the following VBA script
Sub Hide_Forecasts()
Dim c As Range
For Each c In Range("E12:CF12").Cells
If c.Value = "Forecast" Then
c.EntireColumn.Hidden = True
End If
Next c
End Sub
Sub Unhide_Forecasts()
Dim c As Range
For Each c In Range("E12:CF12").Cells
If c.Value = "Forecast" Then
c.EntireColumn.Hidden = False
End If
Next c
End Sub
Sub CheckBox_For()
If CheckBox1.Value = True Then
Call Hide_Forecasts
Else
Call Unhide_Forecasts
End If
End Sub
Please help me out
You haven't said what type of checkbox you're using - Form Control or ActiveX Control.
For an ActiveX Control right-click the control and select View Code.
Use this code that sits behind the worksheet (CheckBox1 will be named after your checkbox).
Private Sub CheckBox1_Click()
Dim Cell As Range
For Each Cell In Me.Range("E12:CF12")
If Cell.Value = "Forecast" Then
'Checkbox returns TRUE/FALSE - Hidden takes TRUE/FALSE so just connect the two up.
Cell.EntireColumn.Hidden = Me.CheckBox1.Value
End If
Next Cell
End Sub
For a Form Control right-click the control and select Assign Macro.
Place this code in a normal module.
Sheet1 is the codename for the sheet (that's the name not in brackets in the Project Explorer).
'Form Control can have three values:
' 1 = Checked
' -4146 = Unchecked
' 2 = Mixed - ignoring that this value may occur.
Public Sub Checkbox_For()
Dim ChkValue As Boolean
'Is value different from -4146? Returns TRUE = Checked or Mixed / FALSE = Unchecked
ChkValue = Sheet1.Shapes("Check Box 1").OLEFormat.Object.Value <> -4146
Dim Cell As Range
For Each Cell In Sheet1.Range("E12:CF12")
If Cell.Value = "Forecast" Then
Cell.EntireColumn.Hidden = ChkValue
End If
Next Cell
End Sub
I have a table with 16 rows.
Each cell in column A has a dropdown list with 10 items.
I want to set a limit for each of these items so that, for example, the first one couldn’t be selected more than 3 times, the second one no more than 2 times and so on.
Is it feasible with or without VBA?
You could use something like this in the sheet module:
Option Explicit
Private OldValue As Variant
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
'Storing the old value of the newly selected cell
OldValue = Target.Value2
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.EnableEvents = False
'Check if the cell that was changed is in column A
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Me.Range("A1:A1000"), Target.Value2) > 2 Then
MsgBox "You can't select more than 2 times the value: " & Target.Value2
'Reset to the old value
Target.Value2 = OldValue
End If
End If
Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Activate()
'If the worksheet just got activated, make sure we have the value of the active cell stored.
If IsEmpty(OldValue) Then
OldValue = ActiveCell.Value2
End If
End Sub
Basically, you have to use the Worksheet_SelectionChange event to store the previous value of the cell when it is selected. Then after the user tries to make a change to the cell, the Worksheet_Change event will look through the first 1000 cells of column A (you can always customize this amount) with the COUNTIF function.
Then, if the number of occurrences of the newly selected value is too high (>2 in this case), an error message is displayed and the value is set back to the previous value.
For safety measures, I've added the Worksheet_Activate event code to make sure that we have the value of the cell even if the user arrives from another sheet and doesn't change the selected cell.
If you want to have different limits for the number of repetitions allowed, you could add a Select Case that would handle that :
...
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
Dim UpperLimit As Long
Select Case Target.Value2
Case Is = "First value": UpperLimit = 3
Case Is = "Second value": UpperLimit = 2
Case Is = "Third value": UpperLimit = 1
Case Else: UpperLimit = 2 'Default limit
End Select
If Application.WorksheetFunction.CountIf(Me.Range("A1:A1000"), Target.Value2) > UpperLimit Then
MsgBox "You can't select more than "UpperLimit & " times the value " & Target.Value2
Target.Value2 = OldValue
End If
...
Additionally, you might want to prevent people to copy paste in that region. If that's the case, this could be useful to you:
https://jkp-ads.com/Articles/CatchPaste.asp
I have an Active-x Dropdown and want to autopopulate other cells in row based on this Dropdown.
I wrote the code in worksheet-change Event but when i select from this drop-down it doesn't trigger The autopopulat code for other rows. Any help would be appreciated.
column 9 is my active-x drop-down list but when i select from the list the code for showing the next cell in my Resource(sheet) doesn't trigger.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSource As Worksheet
Dim r As Long
Set wsSource = ThisWorkbook.Sheets("Source") 'Source sheet
Application.EnableEvents = False
If Target.Column = 9 Then
r = Application.Match(Target.Value, wsSource.Columns(8), 0)
Target.Offset(0, 1) = wsSource.Cells(r, 9)
End If
Application.EnableEvents = True
End Sub
Changing the value in a Active X ComboBox will not trigger a Worksheet_Change. Instead, use a ComboBox_Change event like so:
Private Sub ComboBox1_Change()
MsgBox "Please share your code next time you post. It will greatly help others help you :)"
End Sub
You may need to validate the selected value before running your code which can be done with a simple If ComboBox1.Value = "?" Then
I am trying to make cell E23 as a user input and as a formula cell if user does not enter any value. For eg: If user enters a value in cell E23, then consider that value. If user does not enter any value then copy value from cell B23. Below is the vba code which I tried.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$23" And Target.Value = "" Then
Target.Formula = "=B23"
End If
The code works fine until I change the value in cell B23 by a selection made in the dropdown combobox. When I change the selection in combobox from option 1 to option 2, new value gets updated in cell B23 which must be copied into E23. But it gives me a runtime error '13' Type mismatch.
Any help is appreciated. Thank you
The issue here is that this line
Target.Formula = "=B23"
changes the target cell, and that triggers a Worksheet_Change event that changes the target cell, and that triggers a Worksheet_Change event … and so on.
So you need to disable the events before you change the target cell (and re-enable them afterwards).
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$23" And Target.Value = vbNullString Then
Application.EnableEvents = False
Target.Formula = "=B23"
Application.EnableEvents = True
End If
End Sub
Alternative that works also when multiple cells are selected:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E23")) Is Nothing Then
Application.EnableEvents = False
If Range("E23").Value = vbNullString Then
Range("E23").Formula = "=B23"
Else
Range("E23").Value = Range("E23").Value - Range("E17").Value
End If
Application.EnableEvents = True
End If
End Sub
I have a dropdown validation list in cell A1 with category items like "All", "Online store", "Department store", "Specialized store" and so on. Then, from cell B1 to X1 I have the before mentioned categories except "All".
I want to hide all columns except the ones from the category selected in the dropdown validation list. Also I need to unhide all columns if I select "All" in the list.
I found a sample code on the Internet which works fine to hide the non selected categories -but quite slow response when changing selection-. But I could not make it works together with a code to unhide all columns.
The related code is below. Thanks for your feedback.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R, V
If Target.Address = ("$A$1") Then
V = [A1].Value
For Each R In Range("B1:X1")
R.EntireColumn.Hidden = R.Value <> V
Next
End If
End Sub
To make your code faster turn off ScreenUpdating before looping and back on after
To add the "All" functionality use the code bellow
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 'Target = cell being mdified (changed)
Dim c As Variant, v As String
If Target.Address = "$A$1" Then 'If edited cell is A1
v = Target.Value2 '.Value2 = the text in the cell (without formatting)
With Range("B1:X1")
Application.ScreenUpdating = False
.EntireColumn.Hidden = (v <> "All") 'Hides / Unhides all
If v <> "All" Then 'If all are hidden, unhide the ones for criteria
For Each c In .Cells
If c = v Then c.EntireColumn.Hidden = False
Next
End If
Application.ScreenUpdating = True
End With
End If
End Sub
More details about .Value2