VBA Macro To Select Same Cell on all Worksheets - excel

I'm somewhat newer to VBA, and this particular action seems like it may be out of my current scope of knowledge.
Is there a way to code VBA to have it actively select the same cell on all worksheets as the current cell selected? I have a model I've put together to allow my team to enter data simultaneously regarding product SKUs in Column A on Sheet1, but due to the large amount of information that we enter per item, I used multiple sheets
For example, if I have cell H4 selected on Sheet1, is it possible to have all other sheets active cell H4 upon switching to the other worksheets?
This is what I've come up with so far on a test workbook, but it does not seem to work:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case LCase(Sh.Name)
Case Is = "sheet1", "sheet2", "sheet3"
If CurRow > 0 Then
With Application
.EnableEvents = False
.Goto Sh.Cells(CurRow, CurCol), Scroll:=True
Sh.Range(ActCellAddr).Select
.EnableEvents = True
End With
End If
End Select
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case LCase(Sh.Name)
Case Is = "sheet1", "sheet2", "sheet3"
CurRow = ActiveWindow.ScrollRow
CurCol = ActiveWindow.ScrollColumn
ActCellAddr = ActiveCell.Address
End Select
End Sub
I've located this code below:
Excel VBA code to allow the user to choose the same cell on every sheet
But this requires the user actually enter the cell they'd like to have selected. I am looking for it to be automatic.
Any tips or suggestions? Any help is greatly appreciated.

You can post the following to every sheet in your workbook.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set CurrWS = ActiveSheet
For Each WS In ThisWorkbook.Worksheets
WS.Activate
WS.Range(Target.Address).Select
Next
CurrWS.Activate
End Sub
Every time you select a cell, it will cycle through all the worksheets and select the same cell there. The downside to this is obvious: if you have too many sheets, it's going to be tedious. The other problem is that it's going to cycle through everything. So it might mess up some other sheets if you're going to use this for data entry.
Otherwise, if it's just selecting the cell, then this is harmless though the flicker can be noticeable at times, based on how many sheets you have.
Not as elegant as one would want, but it works. Good luck and let us know if this helps.

Worth noting there is a workbook-level event handler which handles the same event, so you only need to add the code once to the ThisWorkbook code module:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
Sh represents the ActiveSheet.
Probably also worth disabling events while you're selecting the ranges on the other sheets, or that will re-trigger your event handler (don't forget to turn event handling back on before exiting your code!)

This approach will test for hidden sheets. It selects all non-hidden sheets, selects the target cell then returns to the original sheet. It works pretty fast even if you have many many tabs.
targetcell = ActiveCell.Address
OriginSheet = ActiveSheet.Name
Dim ws As Worksheet
For Each ws In Sheets
If ws.Visible = True Then ws.Select (False)
Next ws
range(targetcell).Select
Sheets(OriginSheet).Select

Related

Excel using auto-generated hyperlinks to hide rows in a table

I have a table where I want to be able to hide individual rows at a mouse click. The (seemingly) easiest solution I've found is to have a column filled with hyperlinks that call a macro to hide the row that they're in.
There are two ways of calling macros from hyperlinks: using Worksheet_FollowHyperlink with manual hyperlinks, and using =HYPERLINK.
The former works fine, except there's no way (that I've found) to have them generate automatically when new rows are added to the table. I would have to either manually copy them down every time, which is unviable, or add them with VBA, which adds a bunch of complexity to an otherwise simple task.
The latter generates fine, being a formula, but it doesn't actually work. It doesn't trigger Worksheet_FollowHyperlink, and when using =HYPERLINK("#MyFunction()") it just doesn't hide rows (or do much other than editing cells contents).
Function MyFunction()
Set MyFunction = Selection
Selection.EntireRow.Hidden = True
End Function
Is there a good solution to this?
Rather than a Hyperlink, you could handle a Double Click event on the table column
Something like
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NameOfTableColumn As String
On Error GoTo EH:
NameOfTableColumn = "DblClickToHide" ' update to suit your table
If Not Application.Intersect(Target, Target.ListObject.ListColumns(NameOfTableColumn).DataBodyRange) Is Nothing Then
Target.EntireRow.Hidden = True
Cancel = True
End If
Exit Sub
EH:
End Sub
Please, copy the next code in the sheet code module where the table to be clicked exists. Clicking on each cell in its first column (dynamic to rows adding/insertions/deletions), the clicked row will be hidden:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tbl As ListObject
If Target.cells.CountLarge > 1 Then Exit Sub
Set tbl = Me.ListObjects(1) 'you may use here the table name
If Not Intersect(Target, tbl.DataBodyRange.Columns(1)) Is Nothing Then
Application.EnableEvents = False
Target.EntireRow.Hidden = True
Application.EnableEvents = True
End If
End Sub
It would be good to think about a way to unhide the hidden row if/when necessary. If only a row should be hidden at a time, it is easy to unhide all the rest of column cells...

How to fire worksheet_calculate event when data in a specific cell in a different sheet, is changed?

I created a worksheet_calculate event macro to return a message box (CHANGE DETECTED!) whenever the value in the cells W4656:W4657 change. These values are referenced from another sheet in the same workbook.
My problem is the worksheet_calculate event is fired whenever data is entered anywhere in the workbook.
Could this be modified such that the worksheet_calculate event is fired only when data in a specific cell (a cell in a different sheet) is changed.
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("W4656:W4657")
If Not Intersect(Xrg, Range("W4656:W4657")) Is Nothing Then
MsgBox ("CHANGE DETECTED!!")
ActiveWorkbook.Save
End If
End Sub
Well, if we examine these lines of your code
Dim Xrg As Range
Set Xrg = Range("W4656:W4657")
If Not Intersect(Xrg, Range("W4656:W4657")) Is Nothing Then
Since we set Xrg, then immediately use it, we can rewrite that as
If Not Intersect(Range("W4656:W4657"), Range("W4656:W4657")) Is Nothing Then
which will always be true. So, every time the worksheet Calculates, it will say "CHANGE DETECTED!"
Ideally, you want to store the values in those Cells somewhere, and then just run a comparison between the cells and the stored values. Using Worksheet Variables, you could get the following: (You could also store the values in hidden worksheet as an alternative)
Option Explicit 'This line should almost ALWAYS be at the start of your code modules
Private StoredW4656 As Variant 'Worksheet Variable 1
Private StoredW4657 As Variant 'Worksheet Variable 2
Private Sub Worksheet_Calculate()
On Error GoTo SaveVars 'In case the Variables are "dropped"
'If the values haven't changed, do nothing
If (Me.Range("W4656").Value = StoredW4656) And _
(Me.Range("W4657").Value = StoredW4657) Then Exit Sub
MsgBox "CHANGE DETECTED!", vbInformation
SaveVars:
StoredW4656 = Me.Range("W4656").Value
StoredW4657 = Me.Range("W4657").Value
End Sub
So I've managed to find a solution (work around?) to my problem.
I ended up using a macro to check if the the number in Sheet 38, Cell W4656 which was referenced from Sheet 5, Cell J2, has changed. If yes, fire a macro. If not, do nothing.
I've realized that with the code below, worksheet_calculate event is fired only when there is change in Sheet 5, Cell J2 or Sheet 38, Cell W4656 which is what I want.
Private Sub Worksheet_Calculate()
Static OldVal As Variant
If Range("w6").Value <> 24 Then
MsgBox ("XX")
'Call Macro
End If
End Sub
I've updated my code and made it cleaner, and shamelessly stole some of
Chronocidal's approach (my original code required the workbook to be closed and opened to work). So here is what Sheet5 looks like in my example:
And here is Sheet38. In my example I simply setup formulas in Sheet38!W4656:W4657 to equal Sheet5!$J$2 ... so when Sheet5!$J$2 changes so does Sheet38!W4656:W4657 which will trigger the code.
And copy this code into ThisWorkbook ...
Option Explicit
Dim vCheck1 As Variant
Dim vCheck2 As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If vCheck1 <> Sheet38.Range("W4656") Or vCheck2 <> Sheet38.Range("W4657") Then
MsgBox ("CHANGE DETECTED!!")
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
vCheck1 = Sheet38.Range("W4656")
vCheck2 = Sheet38.Range("W4657")
End If
End Sub
Like this ...

Worksheet_Deactivate() Cannot Use Active Sheet functions

I have 50 datasheets in the project, and nobody remembers to run the save macro when going to another sheet. The bright idea is to use a private sub Worksheet_Deactivate to do the necessary calculations when they select another worksheet. In addition to the 50 datasheets, there are two more worksheets in the workbook for which the calculation must not run. It would be nice if the sub could be put in "Worksheets" rather than replicated 50 times in individual worksheets, but the two other worksheets need to be excluded from processing.
Problem is, the sub defaults to the deactivating worksheet (such as an unqualified "Range.Value =" in the macro code), but the active worksheet is now the worksheet being navigated TO. So any ActiveXXXXX statement directs to the wrong worksheet. Worksheet.Name is disallowed.
Datasheets are numbered 1 to 50. What is needed is a statement early in the deactivate sub similar to
If DeactivatingWorksheet(X) = "BasicInfo" Or "Constants" Then GoTo EndSub
where X is the value of the deactivating worksheet. Of course, X is known only to Excel at the moment of processing.
I can't seem to figure out how to refer to the deactivating worksheet in the macro's IF statement. Any ideas?
Use Workbook_SheetDeactivate(ByVal sh as Object) instead of Worksheet_Deactivate(). The Workbook-level event supplies the name of the sheet being departed, even though in both cases the ActiveSheet has already changed when when event fires. Use sh just like a worksheet variable - sh.Name, sh.ProtectionMode, etc.
Now you don't need 50 subs; just one. Another thing that this allows is, you can "abort" the change to the now ActiveSheet by sh.Activate to the old one (but turn off events or you'll have a lovely infinite loop).
Me also gives the old sheetname and works for the worksheet event, if you still want to go that way. Me is the old one, ActiveSheet is the new one.
If you are using Worksheet_Deactivate and this calls a subroutine in a seperate module, you can pass the name of the deactivating worksheet to the subroutine.
For instance, if your subroutine is something like:
Sub test()
ActiveSheet.Range("whatever") = "something"
ThisWorkbook.Save
End Sub
And you call it from the worksheet like:
Private Sub Worksheet_Deactivate()
Module1.test()
End Sub
You can add a parameter to the subroutine to take the worksheet name, and add a test:
Sub test(worksheetname as string)
If worksheetname <> "dontsavethistab" then
ActiveSheet.Range("whatever") = "something"
'or... you could also do:
Sheets(worksheetName).Range("Whatever") = "something"
ThisWorkbook.Save
End If
End Sub
And call it from your Worksheet_Deactivate event like:
Private Sub Worksheet_Deactivate()
Module1.test (Me.Name)
End Sub
If you wanted to get a little cleaner, instead of the worksheet name you could pass the worksheet object:
Private Sub Worksheet_Deactivate()
Module1.test(Me)
End Sub
Sub test(ws as worksheet)
If ws.name <> "dontsavethistab" then
ws.Range("Whatever") = "something"
ThisWorkbook.Save
End If
End Sub
This way you have the entire worksheet object to do with as you please in your subroutine.

Circular Reference with drop-down list

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

Automatically sum of new added Excel Sheet in Total Sheet

I have an Excel workbook in which I have tabs representing dates along with sum in each tab. Although I can take the sum of all these in the final sheet, I want a formula/macro to get the sum in the total named sheet, when a new spreadsheet is being added.
Note:- the cell in all would remain the same (E56)
I do not understand what you are attempting. Until the user has placed information in the new sheet that results in a value in E56, I see little point to adding the value of NewSheet!E56 to the total sheet.
However I suspect you need to use events. Below are a number of event routines which must be placed in the Microsoft Excel Object ThisWorkbook for the workbook. These just output to the Immediate window so you can see when they are fired. Note: several can be fired for one user event. For example, creating a new worksheet, triggers: "Create for new sheet", "Deactivate for old sheet" and "Activate for new sheet".
Do not forget to include
Application.EnableEvents = False
Application.EnableEvents = True
around any statement within one of these routine that will trigger an event.
Perhaps you need to use SheetDeactivate. When the users leaves a sheet, check for a value in E56. If present, check for its inclusion in the totals sheet. Have a play. Do what your users do. Add to these routines to investigate further. Good luck.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Debug.Print "Workbook_SheetActivate " & Sh.Name
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call MsgBox("Workbook_BeforeClose", vbOKOnly)
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Debug.Print "Workbook_SheetChange " & Sh.Name & " " & Source.Address
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Debug.Print "Workbook_SheetDeactivate " & Sh.Name
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Debug.Print "Workbook_NewSheet " & Sh.Name
End Sub
Sub Workbook_Open()
Debug.Print "Workbook_Open"
End Sub
Extra section in response to clarification of requirement
The code below recalculates the grand total of cell E56 for all worksheets except TOTAL and stores the result in worksheet TOTAL every time the workbook is opened and every time the user changes the current worksheet.
It is difficult to get consistent timings with Excel but according to my experimentation you would need between 500 and 1,000 worksheets before the user would notice a delay switching worksheets because of this recalculation.
I am not sure if you know how to install this code so here are brief instructions. Ask if they are too brief.
Open the relevant workbook.
Click Alt+F11. The VBA editor displays. Down the left you should see the Project Explorer. Click Ctrl+R if you do not. The Project Explorer display will look something like:
.
VBAProject (Xxxxxxxx.xls)
Microsoft Excel Objects
Sheet1 (Xxxxxxxxx)
Sheet10 (Xxxxxxxxx)
Sheet11 (Xxxxxxx)
:
ThisWorkbook
Click ThisWorkbook. The top right of the screen with turn white.
Copy the code below into that white area.
No further action is required. The macros Workbook_Open() and Workbook_SheetDeactivate() execute automatically when appropriate.
Good luck.
Option Explicit
Sub CalcAndSaveGrandTotal()
Dim InxWksht As Long
Dim TotalGrand As Double
TotalGrand = 0#
For InxWksht = 1 To Worksheets.Count
If Not UCase(Worksheets(InxWksht).Name) = "TOTAL" Then
' This worksheet is not the totals worksheet
If IsNumeric(Worksheets(InxWksht).Range("E56").Value) Then '###
TotalGrand = TotalGrand + Worksheets(InxWksht).Range("E56").Value
End If '###
End If
Next
'Write grand total to worksheet TOTAL
' ##### Change the address of the destination cell as required
Worksheets("TOTAL").Range("D6").Value = TotalGrand
End Sub
Sub Workbook_Open()
' The workbook has just been opened.
Call CalcAndSaveGrandTotal
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
' The user has selected a new worksheet or has created a new worksheet.
Call CalcAndSaveGrandTotal
End Sub
I know this is the programming forum, but this particular "need" seems to be solvable without all the plumbing.
I like the old hidden FIRST and LAST sheets trick.
Create a sheet called First
Create a sheet called Last
Place your current data sheets between these two sheets.
Hide the sheets First and Last
Now you can use 3D formulas to sum cells from all these sheets, like so:
=SUM(First:Last!E56)
Now just add sheets to your workbook AFTER the last visible data sheet and Excel will still slip it in ahead of the hidden LAST sheet, so your formula just expands itself that way

Resources