Updating Sheet Naming Macro Automatically - excel

I've found a VBA code that allows me to change the sheet name based on a cell value. That cell values are constantly changing but the 48 sheets that I have do not update unless I click into that sheet. How do I get the marcos to run every time the cell value changes?
Below is the code that I'm using.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Range("DK5")
If Target = "" Then Exit Sub
Application.ActiveSheet.Name = VBA.Left(Target, 31)
Exit Sub
End Sub

If you always activate the sheet before manually changing the contents of cell DK5 in that sheet, then enter this event macro in the each sheet that you want this functionality:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("DK5")) Is Nothing Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Name = Range("DK5").Text
Application.EnableEvents = True
End Sub
If cell DK5 contains a formula, then a different event macro is required.
EDIT#1:
If the DK5 cells contain formulas rather than typed constants, then use these events macro instead:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Me.Name = Me.Range("Dk5").Value
Application.EnableEvents = True
End Sub
(one macro in each sheet)

Related

Should I better modify some codes for .ClearContents?

I have simple macros for clearing cells on "Sheet1", which have drop down lists.
Sub reset1()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
Range("D6:E7").ClearContents
End Sub
Sub reset2()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
End Sub
Then I call these macros on "Sheet1" if the cell values change
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$4" Then
Call reset1
End If
If Target.Address = "$D$6" Then
Call reset2
End If
End Sub
This code is written on the "Sheet1".
Normally it works but sometimes reset1() doesn't work.
I should then save and reopen the excel or run the macro manually.
Should I better modify some codes?
First problem is that with Range("D20:E21") it is not clear in which worksheet that range should be. Always specify the worksheet like Worksheets("Sheet1").Range("D20:E21").
Second problem is that if you .ClearContents in a Worksheet_Change event this is a cell change and triggers another Worksheet_Change event and so on. So it is recommended to disable events Application.EnableEvents = False before changing cells in Worksheet_Change event.
Third problem is that if you test Target.Address = "$D$4" and you copy paste a range where D4 is included your code will not run even if your cell D4 changed. Therefore you always need to work with Intersect.
Option Explicit
Sub Reset1(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9,D6:E7").ClearContents
' alternative:
' Union(ws.Range("D20:E21"), ws.Range("D8:E9"), ws.Range("D6:E7")).ClearContents
End Sub
Sub Reset2(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9").ClearContents
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS ' in any case an error happens make sure events are enabeld again
If Not Intersect(Target, Me.Range("D4")) Is Nothing Then
Reset1 Me ' here we tell Reset1 to take `Me` as worksheet. Me refers to the worksheet `Target` is in.
End If
If Not Intersect(Target, Me.Range("D6")) Is Nothing Then
Reset2 Me
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number Then
Err.Raise Err.Number
End If
End Sub

Preserve Sheet Macro to Link Cells with Sheet Name Change

I have two cells named INPUT_A_1 and INPUT_A_2 in worksheets named "Sheet1" and "Sheet2" respectively, that I'm linking (changing one cell triggers the identical change in the other) with the following sheet macros which work very well:
In Sheet1:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = Range("INPUT_A_1").Address) Then
Sheets("Sheet2").Range("INPUT_A_2") = Target.Value
End If
Application.EnableEvents = True
End Sub
and in Sheet2:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = Range("INPUT_A_2").Address) Then
Sheets("Sheet1").Range("INPUT_A_1") = Target.Value
End If
Application.EnableEvents = True
End Sub
My problem is that owing to the syntax Sheets(sheetname).Range(rangename), if I decide to rename either or both worksheets, then I have to alter the macros accordingly. Is there some sort of workaround to this that does not involve summoning the cells by the corresponding worksheet name? This problem becomes decidedly more compelling when I have 3 or more linked cells each in a different worksheet.
Thanks
The "workaround" is to use the codename of the worksheet instead
Using the Code Name of a Worksheet
The best method of accessing the worksheet is using the code name.
Each worksheet has a sheet name and a code name. The sheet name is the
name that appears in the worksheet tab in Excel.
Changing the sheet name does not change the code name meaning that
referencing a sheet by the code name is a good idea.
Following Storax's excellent suggestion above, here is the fix that I implemented:
In the first worksheet (which can be renamed at will):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = Range("INPUT_A_1").Address) Then
SheetFromCodeName("Sheet2").Range("INPUT_A_2") = Target.Value
End If
Application.EnableEvents = True
End Sub
and in the Second worksheet (which can also be renamed at will):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = Range("INPUT_A_2").Address) Then
SheetFromCodeName("Sheet1").Range("INPUT_A_1") = Target.Value
End If
Application.EnableEvents = True
End Sub
And finally, in any module:
Public Function SheetFromCodeName(CodeName$) As Worksheet
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.CodeName = CodeName Then
Set SheetFromCodeName = sh
Exit For
End If
Next sh
End Function
The SheetName and CodeName association is according to:
If one has multiple sheets with linked cells, and any of the sheets is deleted, an On Error Resume Next should work.
In fact, the Sheet Index could be used instead thereby obviating the need for the SheetFromCodeName routine altogether.
The syntax in this case in the first and second sheets would be
Worksheets(2).Range("INPUT_A_2") = Target.Value
and
Worksheets(1).Range("INPUT_A_1") = Target.Value

EXCEL VBA Dynamic Sheet Name according to a cell value - Not working when formula in the cell

Hej,
I've created a small VBA code to dynamically rename a worksheet.
It's working perfectly when the cell is just manually typed.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C9")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9")
End If
End Sub
But then as soon as I will put a formula concatenating 2 cells values within C9 cell it will not update it automatically.
To make it work I need to enter the cell and type ENTER again and it works.
I have to do same manipulation each time I change a value in on of the 2 cell concatenated.
THANKS for your help guys
You need to capture a different event:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
ActiveSheet.Name = ActiveSheet.Range("C9")
Application.EnableEvents = True
End Sub
NOTE:
We disable events during the name change in case the worksheet contains a formula referencing the tab-name.
this should work:
replace
ActiveSheet.Name = ActiveSheet.Range("C9")
by
ActiveSheet.Name = ActiveSheet.Range("C9").Value
This is an alternate answer if someone still wants to execute this on worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim formulacell As Range
Set formulacell = Range("C9")
Set formulacell = Application.Union(formulacell, formulacell.Precedents)
If Not Intersect(Target, formulacell) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9").Value
End If
Application.EnableEvents = True
End Sub

Excel VBA: When I click the + beside a group of rows

When I click the + beside a group of rows, how do I get it to hide a row outside of the grouped rows.
I tried this but it didn't work.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Rows(11).Hidden = True) Then
Rows(22).EntireRow.Hidden = False
Else
Rows(22).EntireRow.Hidden = True
End If
End Sub
Simply hiding or un-hiding a row will not trigger the Event, To use this Event, you must change a cell value.
EDIT#1
You can almost get what you want with the Worksheet_SelectionChange event.
Expand or collapse the Group of rows containing cell A11 and then click anywhere in the worksheet and row #22 will also expand/collapse. Put the following in a standard module:
Public Sub IsHiddenA11()
With Range("A11")
If .EntireRow.Hidden Then
Range("A22").EntireRow.Hidden = True
Else
Range("A22").EntireRow.Hidden = False
End If
End With
End Sub
and put this in the worksheet code area:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Call IsHiddenA11
Application.EnableEvents = True
End Sub

Excel macro code for clearing formulas in cells does not work when the sheet is protected

After some googling I finally found some code where I could prevent users from placing formulas inside cells. It works great, that's until I protected the sheet. Can anyone tell me what I'm doing wrong? I'm really new to VB.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Range("I39").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
The entire code for my sub is as follows. I need to stop users from pasting in the cells and putting formulas in them.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C26")) Is Nothing Then
Application.CutCopyMode = True
Application.EnableEvents = False
On Error Resume Next
Range("C26").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
Here is a version that facilitates formula checking over a range of cells:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26:I26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If Target.HasFormula Then
Application.EnableEvents = False
Target.ClearContents
MsgBox "formulas not allowed in cell " & Target.Address
Target.Select
Application.EnableEvents = True
End If
End Sub
If you want to allow data entry in cell C26, but not formula entry, then use the Change Event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If rNoFormulas.HasFormula Then
Application.EnableEvents = False
rNoFormulas.ClearContents
MsgBox "formulas not allowed in cell C26"
rNoFormulas.Select
Application.EnableEvents = True
End If
End Sub
If you just want to protect certain cells only, no vba code is need.
follow this step :
Open sheet that contains cells or columns that you want to protect, press ctrl while selecting those cells or column to be protect, then right click, choose format cells, choose protection tab and uncheck the locked option. those cells or column will not be locked although you have protected the sheet. default setting is all cells in the sheets is locked so you must choose which cells you want to unlock while protecting the sheet. you may record a macro if you still want to use vba. hope this help

Resources