How can I get my Macro to run on cell selection? - vba

I am not new to programming, but I am new to using macros in Excel. I am using Excel 2010, trying to run the following macro:
Sub HideUnhideCells(ByVal Target As Range)
Dim keyCell As Range
Set keyCell = Range("C9")
Dim Cells1 As Range
Dim Cells2 As Range
'Call the function on C9 cell change
If Target.Address = "$C$9" Then
'Make Data Source available for for DRG and UCR
If keyCell.Value = "DRG" Or keyCell.Value = "UCR" Then
Set Cells1 = Range("C33")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("C33")
Cells1.EntireRow.Hidden = True
End If
'Make MSA special cells available if MSA is selected
If keyCell.Value = "MSA" Then
Set Cells1 = Range("B34:C35")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("B34:C35")
Cells1.EntireRow.Hidden = True
End If
'Make UCR cells available if UCR is selected
If keyCell.Value = "UCR" Then
Set Cells1 = Range("B36:C39")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("B36:C39")
Cells1.EntireRow.Hidden = True
End If
'Remove extra name cells for 1-file and 2-file values
If keyCell.Value = "DRG" Or keyCell.Value = "ICD-9" Or keyCell.Value = "NCCI_Edits" Or keyCell.Value = "UB04" Then
Set Cells1 = Range("B21:C25")
Set Cells2 = Range("B28:C32")
Cells1.EntireRow.Hidden = True
Cells2.EntireRow.Hidden = True
ElseIf keyCell.Value = "ICD-10" Or keyCell.Value = "NDC" Then
Set Cells1 = Range("B22:C25")
Set Cells2 = Range("B29:C32")
Cells1.EntireRow.Hidden = True
Cells2.EntireRow.Hidden = True
Else
Set Cells1 = Range("B21:C25")
Set Cells2 = Range("B28:C32")
Cells1.EntireRow.Hidden = False
Cells2.EntireRow.Hidden = False
End If
End If
End Sub
I have seen several postings and tutorials that talk about this, but I can't understand why this won't work. Cell C9 is a dropdown list, and I want this macro to run so that cells are shown / not shown based on what is selected in the list. However, if I give it parameters (as shown above) I can't run it in the UI, and if I don't give it parameters, I can only run it manually, which doesn't help me much.
Right now, when I select something from that C9 dropdown list, nothing happens. Can anyone help me figure out why?

Your code looked ripe for a Select Case treatment and there were several things to add about the Worksheet_Change event macro (too many for a comment) so I went ahead and wrote up a draft of the Sub Worksheet_Change. I'm not sure if I have interpreted all of the If ElseIf Else End If but perhaps you can see what I'm trying to do with this.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$9" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Whoa
Rows("21:25").EntireRow.Hidden = False
Rows("28:32").EntireRow.Hidden = False
Rows("33:39").EntireRow.Hidden = True
Select Case Target.Value
Case "DRG"
Rows("33").EntireRow.Hidden = False
Case "MSA"
Rows("34:35").EntireRow.Hidden = False
Case "UCR"
Rows("33").EntireRow.Hidden = False
Rows("36:39").EntireRow.Hidden = False
Case "DRG", "ICD-9", "NCCI_Edits", "UB04"
Rows("21:25").EntireRow.Hidden = True
Rows("28:32").EntireRow.Hidden = True
Case "ICD-10", "NDC"
Rows("22:25").EntireRow.Hidden = True
Rows("29:32").EntireRow.Hidden = True
Case Else
'do nothing
End Select
End If
FallThrough:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume FallThrough
End Sub
Post back into Comments with any problem you have transcribing this for your own purposes and I'll try to assist.

Related

Excel VBA How to enable or disable checkboxes based on certain conditions by using vlookup

I was trying to code in VBA to enable or disable the checkboxes for the mobile plan based on the brand selected as shown in the image.
The table on the left acts as an indicator of the availability of the mobile plans for the respective brands as indicated by "Y" or "N". For example, when the user selected "Apple" from the dropdown list, he is only allowed to tick the Mobile Plan 1.
The attempted solution is based on only one criteria, which is for "Apple" in this case. How do I enhance the coding so that when the user selects "Samsung", the status of the checkboxes will change accordingly?
I planned to declare a variable as an Integer to act as an column indicator (for eg, Apple = 2, Samsung = 3, Nokia = 4) and pass this integer to the each function "CheckBox_Change" and use the VLOOKUP function, but I get an error message:
"procedure declaration does not match description of event or
procedure having the same name"
while I was trying to do so.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
Call CheckBox1_Change
Call CheckBox2_Change
Call CheckBox3_Change
End If
End Sub
Private Sub CheckBox1_Change()
If Range("B3").Value = "Y" Then
CheckBox1.Enabled = True
Else
CheckBox1.Enabled = False
CheckBox1.Value = False
End If
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = False Then
Range("H3").Value = ""
End If
End Sub
Private Sub CheckBox2_Change()
If Range("B4").Value = "Y" Then
CheckBox2.Enabled = True
Else
CheckBox2.Enabled = False
CheckBox2.Value = False
End If
End Sub
Private Sub CheckBox3_Change()
If Range("B5").Value = "Y" Then
CheckBox3.Enabled = True
Else
CheckBox3.Enabled = False
CheckBox3.Value = False
End If
End Sub
I'd go this way (explanations in comments):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
With Range("B2:D2").Find(Target.Value, , xlValues, xlWhole) ' reference the cell with the proper Brand
CheckBox1.Enabled = .Offset(1).Value = "Y" 'set checkbox visibility to match referenced cell column corresponding value
CheckBox2.Enabled = .Offset(2).Value = "Y" ' same as above
CheckBox3.Enabled = .Offset(3).Value = "Y" ' same as above
End With
End If
End Sub
you could also loop between checkboxes "indexes" and avoid some code duplication:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
Dim i As Long
With Range("B2:D2").Find(Target.Value, , xlValues, xlWhole) ' reference the cell with the proper Brand
For i = 1 To 3 ' loop from 1 to 3 (number of checkboxes)
Me.OLEObjects("CheckBox" & i).Enabled = .Offset(i).Value = "Y" 'set current checkbox visibility to match referenced cell column corresponding value
Next
End With
End If
End Sub
Basing on #QHarr's answer, you can reduce the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "G1" Then
Me.CheckBox1.Enabled = (Target = "Apple")
Me.CheckBox2.Enabled = (Target = "Samsung")
Me.CheckBox3.Enabled = (Target = "Samsung")
End If
End Sub
Try the following. It uses Select Case to avoid repeating sections of code and having multiple subs.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "G1" Then
Select Case Target.Value
Case "Apple"
Me.CheckBox1.Enabled = True
Me.CheckBox2.Enabled = False
Me.CheckBox3.Enabled = False
Case "Samsung"
Me.CheckBox1.Enabled = False
Me.CheckBox2.Enabled = True
Me.CheckBox3.Enabled = True
Case Else
Me.CheckBox1.Enabled = False
Me.CheckBox2.Enabled = False
Me.CheckBox3.Enabled = False
End Select
End If
End Sub

Macro script to lock and unlock cells according to values in column A

I am new to macros and I right this macro to lock and unlock specific cells according to values from others:
Private Sub Worksheet_Change(ByVal Target As range)
If [$A1] = "Yes" Then
ActiveSheet.Unprotect ("")
[$E:$E].locked = True
[$F:$F].locked = True
[$N:$N].locked = True
[$O:$O].locked = True
[$P:$P].locked = True
[$X:$X].locked = True
[$Y:$Y].locked = True
[$Z:$Z].locked = True
[$AA:$AA].locked = True
[$AB:$AB].locked = True
[$AC:$AC].locked = True
ActiveSheet.Protect ("")
Else
ActiveSheet.Unprotect ("PASSWORD")
[$E:$E].locked = False
[$F:$F].locked = False
[$N:$N].locked = False
[$O:$O].locked = False
[$P:$P].locked = False
[$X:$X].locked = False
[$Y:$Y].locked = False
[$Z:$Z].locked = False
[$AA:$AA].locked = False
[$AB:$AB].locked = False
[$AC:$AC].locked = False
ActiveSheet.Protect ("")
End If
If [$A1] = "No" Then
ActiveSheet.Unprotect ("")
[$B:$B].locked = True
ActiveSheet.Protect ("")
Else
ActiveSheet.Unprotect ("")
[$B:$B].locked = False
ActiveSheet.Protect ("")
End If
End Sub
By $A1 I mean to run the macro on all cells in column A and lock range of columns.
I don't know how to run and test and see if there any errors.
EDIT: i tried this and still can't test it or see how to work with it
Private Sub Worksheet_Change(ByVal Target As range)
If range("A1") = "Yes" Then
range("B1:B4").locked = True
ElseIf range("A1") = "No" Then
range("B1:B4").locked = False
End If
End Sub
Firstly the routine only makes sense if the cell that has changed is A1 - we should ignore this for any other cell.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim LockCells As Boolean
LockCells = (UCase(ActiveSheet.Range("A1")) = "YES")
Dim ColsToLock
ColsToLock = Split("E,F,N,O,P,X,Y,Z,AA,AB,AC", ",")
Dim r As Range
Dim x As Integer
ActiveSheet.Unprotect ""
For x = 0 To UBound(ColsToLock) - 1
Set r = ActiveSheet.Columns(ColsToLock(x) & ":" & ColsToLock(x))
r.Locked = LockCells
Next x
ActiveSheet.Protect ""
End If
End Sub
Secondly don't forget to unprotect all cells before you start

Faster multiple criteria search/filter excel

Hi guys I made the code below to search for multiple text in a given column. The problem is that it is very slow. Do guys know any other ways to perform it faster?
For example give the array ('foo', 'bar'), The code should iterate on a column and match/filter only the rows that have both texts in any given order.
Sub aTest()
ScreenUpdating = False
Dim selectedRange As Range, cell As Range
Dim searchValues() As String
searchValues = Split(ActiveSheet.Cells(2, 1).Value)
Set selectedRange = Range("A4:A40000")
Dim element As Variant
For Each cell In selectedRange
If cell.Value = "" Then
Exit For
Else
For Each element In searchValues
If Not InStr(1, cell.Value, element) Then
cell.EntireRow.Hidden = True
End If
Next element
End If
Next cell
ScreenUpdating = True
End Sub
I was using it as a filter. copied and pasted the following code with a few modifications. But then I was not able to make the changes to match multiple strings.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iFilterColumn As Integer
Dim rFilter As Range
Dim sCriteria As String
On Error Resume Next
With Target
Set rFilter = .Parent.AutoFilter.Range
iFilterColumn = .Column + 1 - rFilter.Columns(1).Column
If Intersect(Target, Range("rCriteria")) Is Nothing Then GoTo Terminator
Select Case Left(.Value, 1)
Case ">", "<"
sCriteria = .Value
Case Else
sCriteria = "=*" & .Value & "*"
End Select
If sCriteria = "=" Then
.Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn
Else
.Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn, Criteria1:=sCriteria
End If
End With
Terminator:
Set rFilter = Nothing
On Error GoTo 0
End Sub
I'm assuming this:
Set selectedRange = Range("A4:A40000")
It's because the size is not defined properly, the following should limit to the right long
Set selectedRange = Range("A4:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If it doesn't affect, I always use these codes to speed up Excel (Instead of only ScreenUpdating alone).
Sub ExcelNormal()
With Excel.Application
.Cursor = xlDefault
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub
Sub ExcelBusy()
With Excel.Application
.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.StatusBar = False
End With
End Sub
Note: In the future Probably Code Review would be better place to post.

VBA - Hide/unhide row based on hidden/unhidden status of another row

I'm trying to write some VBA code that will unhide an entire row if another specific row is hidden. This macro also hides a range of rows based on the value in a specific column. This aspect works fine - I have reliable code. I can't get the first function I described to work. Should be easy to do, just don't know the syntax. This subroutine should execute upon opening the workbook.
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
targ = "DETAILS!B6"
msg = "DETAILS!B42"
msg.EntireRow.Hidden = True
With Range("DETAILS!B6:B40")
.EntireRow.Hidden = False
For Each cell In Range("DETAILS!B6:B40")
Select Case cell.Value
Case Is = 0
cell.EntireRow.Hidden = True
End Select
Next cell
End With
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
You need to set the variables like below
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
Set targ = "DETAILS!B6"
Set msg = "DETAILS!B42"
msg.EntireRow.Hidden = True
With Range("DETAILS!B6:B40")
.EntireRow.Hidden = False
For Each cell In Range("DETAILS!B6:B40")
Select Case cell.Value
Case Is = 0
cell.EntireRow.Hidden = True
End Select
Next cell
End With
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
Oh! Just put Set before targ and msg since they're a Range. When declaring ranges, you have to have Set, i.e. Set myRng = Range("A1:A10").
You might need to do Set targ = Range("Details!B6") if just Set Targ = "DetailsB6" doesn't work.
On second thought, I don't think Set Targ = "Details!B6" will work if you are Dim Targ as Range. You're dim'ing as a Range, but are declaring it as like a string. You need this to be a Range, to use it like targ.EntireRow.Hidden, etc.
Though you can call range objects like this : Range("DETAILS!B6:B40")
In vba it is better accepted to call it like this: Sheets("DETAILS").Range("B6:B40")
I fixed a few more syntax errors:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
Set targ = Sheets("DETAILS").Range("B6")
Set msg = Sheets("DETAILS").Range("B42")
msg.EntireRow.Hidden = True
With Sheets("DETAILS").Range("B6:B40")
.EntireRow.Hidden = False
End With
For Each cell In Sheets("DETAILS").Range("B6:B40")
Select Case cell.Value
Case 0
cell.EntireRow.Hidden = True
End Select
Next cell
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub

Dynamic Excel graph

At the moment, I have created four different graphs that appear only if they are called in my drop-down box on cell D5. However, I am trying to create a single dynamic graph that populates its data depending on what is in cell D5.
Is this possible?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will cause an alert when they are changed.
Set KeyCells = Range("D5")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Range("D5") = "Tremont" Then
ActiveSheet.ChartObjects("Tremont").Visible = True
ActiveSheet.ChartObjects("SaybrookPointe").Visible = False
ActiveSheet.ChartObjects("21Fitzsimons").Visible = False
ActiveSheet.ChartObjects("Mezzo").Visible = False
ElseIf Range("D5") = "Saybrook Pointe" Then
ActiveSheet.ChartObjects("Tremont").Visible = False
ActiveSheet.ChartObjects("SaybrookPointe").Visible = True
ActiveSheet.ChartObjects("21Fitzsimons").Visible = False
ActiveSheet.ChartObjects("Mezzo").Visible = False
ElseIf Range("D5") = "21 Fitzsimons" Then
ActiveSheet.ChartObjects("Tremont").Visible = False
ActiveSheet.ChartObjects("SaybrookPointe").Visible = False
ActiveSheet.ChartObjects("21Fitzsimons").Visible = True
ActiveSheet.ChartObjects("Mezzo").Visible = False
ElseIf Range("D5") = "Mezzo" Then
ActiveSheet.ChartObjects("Tremont").Visible = False
ActiveSheet.ChartObjects("SaybrookPointe").Visible = False
ActiveSheet.ChartObjects("21Fitzsimons").Visible = False
ActiveSheet.ChartObjects("Mezzo").Visible = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will cause an alert when they are changed.
Set KeyCells = Range("D5")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Range("D5") = "Tremont" Then
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).XValues = Range(X_axis_values)
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).Name = "Tremont"
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).Values = Range(Y_axis_values)
'If a bar graph,
with Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB= RGB(0,0,0)
.Transparency = 0
.Solid
End With
ElseIf Range("D5") = "Saybrook Pointe" Then
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).XValues = Range(X_axis_values)
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).Name = "Saybrook Pointe"
Activesheet.Chartobjects("Single_Dynamic_Chart").FullSeriesCollection(1).Values = Range(Y_axis_values)
'If a bar graph,
with Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB= RGB(0,0,0)
.Transparency = 0
.Solid
End With
ElseIf Range("D5") = "21 Fitzsimons" Then
'Similarly like above cases, define the X-axis,the series name and the values.
ElseIf Range("D5") = "Mezzo" Then
'Similarly like above cases, define the X-axis,the series name and the values.
End If
End If
End Sub
Following these links would give you more information on how to work more on charts
Intoduction to charts
Chart series elements
I see no problem with this. But you can make it simpler and avoid hardcoding the names, and you can save some inc as well:
Dim ch As ChartObject
For Each ch in ActiveSheet.ChartObjects
ch.Visible = ch.Name = Range("D5").Value
Next
But, well, you need to remove the spaces from the names in the D5 list, letting them be exactly equal to the charts' names.