Apologies any incorrect terms, this is the first time I am trying to code a macro. I currently have the following code running:
Private Sub Worksheet_Deactivate()
'Alpha Show / Hide
If Sheets("Project_selection").Range("D4") = Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf Sheets("Project_selection").Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End Sub
which has been cobbled together from other codes and google. It works, but only when I move out of the sheet, which I think is being driven by the first line.
I would actually like it to activate when the Cell D4 in the 'Project_selection' sheet (a separate sheet to the one the code is on) gets changed - does anyone know how I would do that? I have seen references to worksheet_change, but I do not understand how one defines the target/range to get the appropriate reference.
Hope that makes sense and thanks in advance!
If you were to place the following code under the sheet (Project_selection), it would fire that event every time a change has happened in Cell D4:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Project_selection")
If Target.Address = "$D$4" Then
If ws.Range("D4") = ws.Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf ws.Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End If
End Sub
Related
Thanks in advance for your help. I have been working on this for a few days now and have tried a few different options. What I need done is to hide specific rows of an excel sheet based on the contents of an active X dropdown. I have indexed the dropdown to a cell and every time the user changes the dropdown selection, the indexed cell contains their selection as either text or number (whichever makes it easiest to code - I've been trying both). I want to keep the code as close to how it is at the moment if possible. I'm sure there are shorter/ more convenient methods, but I just want this over. I think the issue is that when the user selects a new option from the dropdown, the macro isnt refreshing and showing ALL rows again before it begins to hide the new rows. As a result, I just end up with a whole bunch of hidden rows based on what was originally selected. I hope that makes sense.
See the code below for what I've already tried. I also tried this one too, but had the same issue (that the macro wasnt refreshing and showing ALL rows before applying another Hide function)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("U13"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "Brand Health": Rows("19:39").EntireRow.Hidden = True
Rows("40:60").EntireRow.Hidden = False
Case Is = "Brand Imagery": Rows("38:60").EntireRow.Hidden = True
Rows("61:81").EntireRow.Hidden = False
Case Is = "NPS": Rows("30:82").EntireRow.Hidden = True
Rows("83:102").EntireRow.Hidden = False
Case Is = "Talent": Rows("35:103").EntireRow.Hidden = True
Rows("104:126").EntireRow.Hidden = False
Case Is = "Shows": Rows("37:127").EntireRow.Hidden = True
Rows("128:148").EntireRow.Hidden = False
End Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target`enter code here` As Range)
Sheets("Brand Tracking Dashboard").Rows("1:1000").EntireRow.Hidden = False ' Move this to the top
If Target.Address = ("$U$13") And Target.Value = 1 Then
Sheets("Brand Tracking Dashboard").Rows("19:39").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("59:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 2 Then
Sheets("Brand Tracking Dashboard").Rows("43:63").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("80:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 3 Then
Sheets("Brand Tracking Dashboard").Rows("32:84").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("101:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 4 Then
Sheets("Brand Tracking Dashboard").Rows("37:106").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("121:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 5 Then
Sheets("Brand Tracking Dashboard").Rows("37:129").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("145:1000").EntireRow.Hidden = True
End If
End Sub
What should happen is that after the user makes a selection, I guess the logic should be that the sheet is told to show ALL rows before applying the hide line command.
You are almost there - your guess was right. You just need to unhide all the rows before you hide the right ones based on the selection.
The first sub you posted is trying to do some unhiding, but it's only unhiding a few rows - and as you can't control what order the user selects the values in, it's probably trying to unhide the wrong ones. (Work through what happens if a user selects "Brand Health" followed by "Shows").
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
On Error GoTo errHandler
Application.ScreenUpdating = False
Set ws = Target.Worksheet
If Not Application.Intersect(ws.Range("U13"), Range(Target.Address)) Is Nothing Then
ws.Rows("19:148").Hidden = False 'edit this to include all the rows that could be hidden
Select Case Range("U13").Value
Case Is = "Brand Health"
ws.Rows("19:39").Hidden = True
Case Is = "Brand Imagery"
ws.Rows("38:60").Hidden = True
Case Is = "NPS"
ws.Rows("30:82").Hidden = True
Case Is = "Talent"
ws.Rows("35:103").Hidden = True
Case Is = "Shows"
ws.Rows("37:127").Hidden = True
End Select
End If
Application.ScreenUpdating = True
Exit Sub
errHandler:
Application.ScreenUpdating = True
End Sub
I've made a few other improvements:
ActiveSheet.Activate wasn't doing anything
You shouldn't rely on a particular sheet being the active one - what if the user changes it halfway through your macro? So I get the right worksheet at the start and use that throughout (make sure we are always working on the correct sheet)
Target could be a range of cells; you are only interested in the value of U13 so make that the condition for the Select Case
it's neater and faster to turn off screen updating - making sure it always gets turned on afterwards (even if there's an error).
Rows("xx:yy") returns whole rows so there's no need for EntireRow
I have a sheet with a lot of code that I have worked on throughout the last couple of years but I am new to VBA and did not incorporate any error handling. I tried a few things but I could never make it work. It did not really affect me until recently. Most of my routines are driven by a cell that contains a sales price (cell D5). I am using Worksheet_Change ByVal target as range to change things when different cells are changed so when the sales price is changed it starts running routines.
What I have noticed is that this particular routine is the first one that gives me a VBA error if I delete the sales price in cell D5. So I thought I can ask someone to give me a simple code to catch the empty cell before the routine fires and maybe a popup saying "Sales Price cannot be blank" and perhaps revert to the previous value of that cell. The debug error takes me to the line of code that starts with "If Sheets("Main").Range("D6").Value < 0.8001"
Sub Calc_MI()
If Sheets("Main").Range("D12").Value = "FHA" Then
Sheets("Main").Range("D16").Value = 0.85
Else
If Sheets("Main").Range("D6").Value < 0.8001 Or
Sheets("Main").Range("D12").Value = "VA" Then
Sheets("Main").Range("D16").Value = ""
Else
If Sheets("Main").Range("G14").Value > 0.45 Then
Sheets("Main").Range("D16").Value = (Sheets("Closing
Costs").Range("BP100").Value + Sheets("Closing
Costs").Range("BP101").Value + Sheets("Closing
Costs").Range("BP102").Value)
Else
Sheets("Main").Range("D16").Value = (Sheets("Closing
Costs").Range("BP100").Value + Sheets("Closing
Costs").Range("BP102").Value)
End If
End If
End If
End Sub
any help would be greatly appreciated :-)
you could place this in "Main" sheet code pane
Option Explicit
Dim oldVal As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$5" Then
If IsEmpty(Target) Then
MsgBox "Sales Price cannot be blank"
Application.EnableEvents = False ' disable events to prevent change event fire in an infinite loop
Target.Value = oldVal ' restore old backup value
Application.EnableEvents = True ' enable events back
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$5" Then oldVal = Target.Value ' if D5 selected then backup its value
End Sub
I've got a workbook with 5 sheets: Sheet1, Sheet2, Sheet3, Sheet4, Sheet5. The first sheet: "Sheet" has a cell: "C3" with a drop down menu with 4 different options: Opt1, Opt2, Opt3, Opt4.
Depending on what is selected in this drop down menu, I'd like different columns to be hidden in the various sheets - in real time. And if nothing is entered, I'd like no columns hidden.
I've entered the below code which partly works but I think there's an issue because I've selected overlapping columns to hide - not completely sure.
Additionally, I'd like to work in hiding particular rows as well as the column below, depending on what different option you select in the drop down menu.
Also, I'll replicate hiding the same columns across all Sheets1-5.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("C3").Value = "Opt1" Then
Sheets("Sheet1").Columns("G:L").EntireColumn.Hidden = True
Sheets("Sheet1").Columns("N:T").EntireColumn.Hidden = True
Else
Sheets("Sheet1").Columns("G:L").EntireColumn.Hidden = False
Sheets("Sheet1").Columns("N:T").EntireColumn.Hidden = False
End If
If Range("C3").Value = "Opt2" Then
Sheets("Sheet1").Columns("B:F").EntireColumn.Hidden = True
Sheets("Sheet1").Columns("N:T").EntireColumn.Hidden = True
Else
Sheets("Sheet1").Columns("B:F").EntireColumn.Hidden = False
Sheets("Sheet1").Columns("N:T").EntireColumn.Hidden = False
End If
If Range("C3").Value = "Opt3" Then
Sheets("Sheet1").Columns("B:M").EntireColumn.Hidden = True
Else
Sheets("Sheet1").Columns("B:M").EntireColumn.Hidden = False
End If
If Range("C3").Value = "Opt4" Then
Sheets("Sheet1").Columns("B:AB").EntireColumn.Hidden = True
Else
Sheets("Sheet1").Columns("B:AB").EntireColumn.Hidden = False
End If
End Sub
Following on from my comment. You can define the entire range of columns as a variable e.g. entireRange and set this to unhidden at the start of each worksheet change.
Add fully qualified references to the ranges i.e. ThisWorkbook.Sheets("Sheet1") or ws (as a variable shown below).
As everything is unhidden at start Else is not needed for each If statement. This is probably where confusion arises.
Change to a Select case statement as you are testing the value of a single cell against different expected values.
Combine your separate line column ranges that you are hiding into one line statements e.g.
Sheets("Sheet1").Columns("G:L").EntireColumn.Hidden = True
Sheets("Sheet1").Columns("N:T").EntireColumn.Hidden = True
Becomes:
ws.Range("G:L,N:T").EntireColumn.Hidden = True
You code would then look like the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim ws As Worksheet
Dim entireRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set entireRange = ws.Columns("B:AB")
entireRange.EntireColumn.Hidden = False
Select Case ws.Range("C3") 'Test the value of C3
Case "Opt1"
ws.Range("G:L,N:T").EntireColumn.Hidden = True
Case "Opt2"
ws.Range("B:F,N:T").EntireColumn.Hidden = True
Case "Opt3"
ws.Range("B:M").EntireColumn.Hidden = True
Case "Opt4"
entireRange.Hidden = True
End Select
End Sub
This will be easier to debug in terms of where things are being hidden or unhidden.
I have rewritten your code to make it easy to read and edit. My goal was to make the code as short as possible. I changed your if statement into a Select Case. It's more elegant and I think it's faster, but don't take my word for it.
The problem that had to be tackled was that if I select Opt1 and then select Opt2, the columns from Opt1 would still be hidden. So before the code hides anything, it automatically unhides all the columns in the range B:AB.
I added the Case Else to unhide all columns if you entered anything but Opt1, Opt2, Opt3 or Opt4. This could easily be changed into a MsgBox that warns the user that the entered value is incorrect. You can remove this line if you have limited the choice for the users already.
The Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' Unhide Columns
Worksheets("Sheet1").Range("B:AB").EntireColumn.Hidden = False
Select Case Worksheets("Sheet1").Range("C3").Value
Case "Opt1"
Worksheets("Sheet1").Range("G:L,N:T").EntireColumn.Hidden = True
Case "Opt2"
Worksheets("Sheet1").Range("B:F,N:T").EntireColumn.Hidden = True
Case "Opt3"
Worksheets("Sheet1").Range("B:M").EntireColumn.Hidden = True
Case "Opt4"
Worksheets("Sheet1").Range("B:AB").EntireColumn.Hidden = True
' If anything else is entered, the columns will be unhidden.
Case Else
Worksheets("Sheet1").Range("B:AB").EntireColumn.Hidden = False
End Select
End Sub
I have a custom function that detects if a cell is bold
Function isBold(cellBold)
If cellBold.Font.Bold = True Then
isBold = 1
ElseIf cellBold.Font.Bold = False Then
isBold = 0
Else
isBold = 0
End If
End Function
Puts 1 in a cell if the reference cell is bold and 0 if it is not bold
This works well and all the first time around but if I make the reference cell bold the number stays at 0. Automatic calculations are on, the only way for the function to calculate again is to retype the function
Adding Application.Volatile to the top of your function will make it auto update when the workbook change event is fired.
Function isBold(cellBold)
Application.Volatile
If cellBold.Font.Bold = True Then
isBold = 1
ElseIf cellBold.Font.Bold = False Then
isBold = 0
Else
isBold = 0
End If
End Function
This will not help you if you just bold a result but you can add an event to the sheet you're working on
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub
If both of these things are in place, your formula will update every time you select a different cell which may work well enough for you. However, I suggest using this method with caution because if you have a very large number of formulas this could slow things down.
-Edit- This should fix the copy paste issue.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col As Range
For Each col In ActiveSheet.UsedRange.Columns
col.Calculate
Next
End Sub
OK, So I'll be the first to admit this is not an ideal solution, and is pretty hackish. But i think it will fix your solution.
After adding the volatile line to your code as so:
Function isBold(cellBold)
Application.Volatile True
If cellBold.Font.Bold = True Then
isBold = 1
ElseIf cellBold.Font.Bold = False Then
isBold = 0
Else
isBold = 0
End If
End Function
First Change your Workbook_Open to this:
Private Sub Workbook_Open()
Sheets("Sheet1").rngLastCell = Range("A1").Address
Sheets("Sheet1").fntLastCell = Range("A1").Font.Bold
End Sub
Then on the worksheet you are working with (In my example Sheet1) Add this to the Worksheet function:
Option Explicit
Public fntLastCell As Boolean
Public rngLastCell As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Sheets("Sheet1").Range(rngLastCell).Font.Bold <> fntLastCell Then
Calculate
End If
Sheets("Sheet1").rngLastCell = Target.Address
Sheets("Sheet1").fntLastCell = Target.Font.Bold
End Sub
Now to have it work you must Save then close, Then re open your worksheet.
This works by setting 2 global variables each time you select a new cell.
a Boolean variable that states weather the Last Cell selected WAS PREVIOUSLY Bold or not. And a String Variable that references that same Cell. So, you can now check the Bold state of the cell you exited (when it was entered) against the Current Bold State of the cell you just existed and if there was a change it will calculate the workbook. Otherwise nothing will happen.
Hope this works and helps,
Cheers
I am new to scripting and I am trying to improve a existing Macro. I recorded a macro to remove duplicate and added it in a Main function which calls some other functions, but I am getting this error when I add the macro I recorded:
Run-time error '1004': Unable to set the hidden property of the range class
The code looks like
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
End Sub
Some possible answers:
You have a comment in one of the selected cells
You have some drawn objects which don't resize with text
Your worksheet is protected
When you set a breakpoint on the first line of the event handler, and then press F8 to step through the macro, I'm assuming it crashes on the line:
Range("A48:A136").EntireRow.Hidden = True
When people say "You have a comment in one of the selected cells", keep in mind that THE COMMENT CAN BE IN A DIFFERENT COLUMN.
If a comment box is over the column you're trying to hide (like if you're hiding every column to the right and you have comments in a completely different column), this is the error you'll get.
If you try to manually hide the column, you'll get a different confusing error which is something along the lines of "hiding this column will push an object off of the sheet."
The comment box a few columns over is the object.
^ This would have saved me about 40 minutes of debugging.
try this :)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWorkbook.Unprotect "password_here"
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
ActiveWorkbook.Protect "password_here"
End Sub
This should work for you :)