This works perfectly, but I only want it to reference a single sheet instead of every sheet in the workbook
Private Sub Worksheet_Change()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "AA120").End(xlUp).Row
On Error Resume Next
For Each c In Range("AA5:AA120" & LastRow)
If c.Value = "0" Then
c.EntireRow.Hidden = True
ElseIf c.Value > "0" Then
c.Activate
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub
As i can see you only need to insert this code in one sheet which ever you want. Rightclick on sheet name(tab) and select "view code", then paste this code. BUT! If this runs on every sheet, then you also need to delete code from "This Workbook" --> (Alt+F11) and select "This workbook", then erase this code from there.
You have to use
Private Sub Worksheet_Change(ByVal Target As Range)
instead.
According to the great Chip Pearson, "The events and their procedure declarations are fixed. You must not alter the name or parameter list of an event procedure." (I do not have a system with Office to test it).
You would insert your Sub in a sheet module, and it will work only on that sheet.
Related
I have an add-in that creates a report on a file, the report has a pivot table like this:
The above is now sorted on the leftmost column. To make it easier for the user I want to add a Worksheet_SelectionChange event code that if I click on a cell with "Kolli" or "Vikt" in this range visible in the image sort the table on this column.
The sorting is not the issue, but can a add-in file notice selection change?
I would need something like a ACTIVEsheet_SelectionChange, and then read the Target so that it's the correct workbook, sheet and range.
Is that even possible? Or do I need to somehow write the code in the "target" workbook worksheet?
Please, try the next way:
Put the next declaration on top of the add-in ThisWorkbook code module (in the declarations area):
Public WithEvents appEvHandler As Application
Put in Workbook_Open event the next code, to activate the event handler:
Private Sub Workbook_Open()
Set appEvHandler = Application 'this code line can be placed in any standard event, when need to activate the `appEvHandler` events
End Sub
Copy this new event code in ThisWorkbook code module:
Private Sub appEvHandler_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Parent.Name <> ThisWorkbook.Name Then
MsgBox Sh.Parent.Name & " workbook, sheet " & Sh.Name & " changed selection to " & Target.Address & "..."
Else
Debug.Print "Selection changed in this workbook..."
End If
End Sub
You can also filter the sheet (name) where the event to do something, on a similar mechanism.
I could also suggest the specific event code, but I could not understand what "I click on a cell with "Kolli" or "Vikt" in this range visible" does mean. No rows headers, I cannot understand which range to be the one triggering what you need... I mean to restrict the range where the event to be used. Is that row part of the table header? Anyhow, this part should be easy to handle, I think.
In case anyone else is looking for a code to sort a pivot table on column header when you click on it this is the code I use now thanks to FaneDuru.
Private Sub appEvHandler_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Parent.Name <> ThisWorkbook.Name Then
If Sh.Name = "Resultat" And Sh.Range("B3").Value = "Plockare" And Sh.Range("B4").Value = "Snitt" And Sh.Range("B5").Value = "Per timme" And Sh.Range("A11").Value = "Namn" And Sh.Range("B11").Value = "Plockare" Then
If Target.Row = 11 Then
If Target.Column > 2 And Target.Column <= Sh.Cells(4, 2).End(xlToRight).Column Then
On Error Resume Next
Sh.PivotTables("Pivottabell1").PivotFields("Kvittering av").AutoSort xlDescending, Target.Value, Sh.PivotTables("Pivottabell1").PivotColumnAxis.PivotLines(Target.Column - 2), 1
On Error GoTo 0
End If
End If
End If
End If
End Sub
The Pivot table is placed in cell B11, that is why target.column -2 is correct for me.
If yours is in A, then you probably want target.column -1
And the header is on row 11, that is why the code only reacts to target.row = 11
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
Google hasn't given me quite what I want, I thought maybe SO might have the answer.
Instead of using a input box or user prompt that asks the user for info that will be stored in cell, I'm looking for some code to simulate clicking in the formula bar. I am currently using sendkeys method with "F2" to allow the user to enter info into the selected cell. It would be much easier to look into the formula bar, instead of a single cell in a sea of data.
Sub CopyTemplate()
'ActiveWorkbook.Save
Worksheets("HR-Cal").Activate
Dim rng As Range
Dim trng As Range
Dim tco As String
'Use the InputBox select row to insert copied cells
Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8)
If rep = vbCancel Then
End If
startrow = rng.Row
' MsgBox "row =" & startrow
Range("AG2") = startrow
Application.ScreenUpdating = False
'copy template block
Range("C6").End(xlDown).Select
Range("AG1") = ActiveCell.Row
tco = "A5:AN" & Range("AG1")
Range(tco).Select
Selection.Copy
Range("A" & Range("AG2")).Activate
Selection.Insert Shift:=xlDown
Range("c100000").End(xlUp).Select
Selection.End(xlUp).Select
'select first value
Range("AG1:AG2").ClearContents
Application.ScreenUpdating = True
SendKeys "{F2}"
SendKeys "{BS}"
End Sub
when the codes runs this is what the user sees (col 2 col 2621)
I don't believe there is a single keypress to "activate" the formula bar. There is probably a way to do with multiple keypress events like <alt><tab><tab>...~nine years later and a couple of other keys~...<tab><tab>
The quicker and more direct way would be to turn off the "EditDirectlyInCell" setting:
Application.EditDirectlyInCell = False
This will bring the cursor to the formula bar when you sendkey F2
You could just turn this thing off on Workbook_Open() in the workbook's code:
Private Sub Workbook_Open()
Application.EditDirectlyInCell = False
End Sub
Perhaps on Workbook_BeforeClose() you could toggle that setting back on so you don't change their defaults:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EditDirectlyInCell = True
End Sub
maybe this will help, i set the Application.EditDirectlyInCell to false, before entering cell editing, then call DoEvents before returning EditDirectlyInCell to true
Sub EditRange(ByVal Target As Range) 'so any change in target would not affect
'the caller's variable
Set Target = Target.Areas(1).Resize(1, 1) 'to make sure the target is single cell
Target.Worksheet.Activate 'to make sure the worksheet is active
Target.Activate 'activate the designated cell
Application.EditDirectlyInCell = False 'turn cell editing to false, any attempt _
to edit cell will be done in formula bar
SendKeys "{F2}" 'send F2 to start editing the cell
DoEvents 'make sure every command is fully executed
Application.EditDirectlyInCell = True 'return in cell editing to default value
End Sub
Is it possible in MS. Excel or VBA to have a circular reference with a drop-down list?
Here is what I am after: I want to generate on two sheets (sheet 1, sheet 2) a drop down list that says either "Complete" or "Incomplete." If I change sheet 1 from Complete to Incomplete, I want sheet 2 to say the same thing, but I also want vice versa
(If I change sheet 2 from Complete to Incomplete, I want sheet 1 to change).
Is this possible?
Acting on a change in any of the worksheets' B5 range seems a likely way to proceed but the individual Worksheet_Change event macros have some limitations.
The code has to be repeated across many worksheet code sheets and any modifications have to be cloned across the same. New worksheets require the sub procedure to be incorporated into their own code sheets.
Without disabling events before writing new values, each worksheet receiving a new value is going to initiate its own Worksheet_Change event macro which in turn will rewrite values which will trigger more events. A cascade event failure is almost sure to happen.
By exchanging the Worksheet_Change event macro for the more universal Workbook_SheetChange event macro located in the ThisWorkbook code sheet, all of the code can be localized to a single location. Adjustments are made in a single place and new worksheet will automatically be added to the queue of worksheets to process. They can easily be added to the array of worksheet not to process as well.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$B$5" And Sh.Name <> "Sheet3" Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim w As Long
For w = 1 To Worksheets.Count
With Worksheets(w)
'skip this worksheet and Sheet3
If CBool(UBound(Filter(Array(Sh.Name, "Sheet3"), _
.Name, False, vbTextCompare))) Then
.Range("B5") = Target.Value
'.Range("B5").Interior.ColorIndex = 3 '<~~testing purposes
End If
End With
Next w
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Any worksheet that is not to receive an update to the value in its own B5 cell can be added to the array used in the Filter function. Currently, Sheet3 and the worksheet that initiated the Workbook_SheetChange event are excluded.
I would create a hidden sheet that contains the range for input and the linked cell. Then link both drop downs to the list and the linked cell. Then when you change one it will change the other. The key here is the Linked Cell. This is assuming Excel 2013, using the Form control Combo Box.
Please have a look at #Jeeped's answer as it is the most efficient answer.
After a little trial and error I've gotten this to work with a cell with a "Data Validation" dropdown menu. In my test case, I had 3 sheets with a Data Validation list in cell $B$5 on each worksheet linked to a list on a hidden sheet to populate the list, the sheet with the options list was "Sheet3" and did not contain a data validation list.
The Code below needs to be copied to every sheet module.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
If Target.Address = "$B$5" Then
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = Me.Name And Not ws.Name = "Sheet3" Then
If Not ws.Range(Target.Address) = Me.Range(Target.Address) Then
ws.Range(Target.Address) = Me.Range(Target.Address)
End If
End If
Next ws
End If
End Sub
This is fairly easy with activeX comboboxes on the sheets
On the workbook module add the code below to populate the comboboxes
Private Sub Workbook_Open()
With ThisWorkbook
With .Worksheets("Sheet1").ComboBox1
.AddItem "Complete"
.AddItem "Incomplete"
End With
With .Worksheets("Sheet2").ComboBox1
.AddItem "Complete"
.AddItem "Incomplete"
End With
End With
End Sub
On the "Sheet1" Module add
Private Sub ComboBox1_Change()
If Me.ComboBox1 = "Complete" Then
ThisWorkbook.Worksheets("Sheet2").ComboBox1.Value = "Complete"
ElseIf Me.ComboBox1 = "Incomplete" Then
ThisWorkbook.Worksheets("Sheet2").ComboBox1.Value = "Incomplete"
End If
End Sub
On the "Sheet2" Module add
Private Sub ComboBox1_Change()
If Me.ComboBox1 = "Complete" Then
ThisWorkbook.Worksheets("Sheet1").ComboBox1.Value = "Complete"
ElseIf Me.ComboBox1 = "Incomplete" Then
ThisWorkbook.Worksheets("Sheet1").ComboBox1.Value = "Incomplete"
End If
End Sub
see codes below.
I have the 'beforesave' code in the Workbook module and it works fine when I'm in the active sheet. However from the table I use on sheet 2 I also have a pivot table on sheet 1. To refresh my pivot I use an inserted button with an attached macro (this is in the module section)
Sub Refresh_Pivot()
'
' Refresh_Pivot Macro
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.Save
End Sub
On Activate.Workbook.Save its starts to act on my other code (which is in the workbook module), I want this to happen as a pivot table with missing data is not a good tool. However on using this it defaults with an error and highlights the cell.Offset(0, 1).Select - How can I prevent this?
Ideally I want the user to select OK on the msgbox and then the screen page changes to Sheet 2 and highlights the offending cell.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim esave As Range
Dim psave As Range
Dim jsave As Range
Dim RAll As Range
Dim cell As Range
Set esave = Sheet2.Range("Table1[Estimated Claim (USD)]")
Set psave = Sheet2.Range("Table1[Provisional Claim (USD)]")
Set jsave = Sheet2.Range("Table1[Agreed Claim (USD)]")
Set RAll = Union(esave, psave, jsave)
For Each cell In RAll
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End Sub
.Select should be avoided.
INTERESTING READ
I also want to know why are you trying to select that cell? What is the purpose. If you want to interact with it, then you can do that without selecting it. For example
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
With cell.Offset(0, 1)
'
''~~> Do something
'
End With
Exit For
End If
Having said that if you still want to select that cell then you need to be on that sheet. There are two ways now. One is like I mentioned in the comment above.
Add Sheet2.Activate just before For Each cell In RAll in the Workbook_BeforeSave event or do that in the button's click event.
Sub Refresh_Pivot()
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Sheet2.Activate
ActiveWorkbook.Save
End Sub
Another point. You might want to pass Cancel = True before the Exit For to disable the save?