Macro for these posts ( Question 2 )
https://excelfox.com/forum/showthrea...ll=1#post13442
https://excelfox.com/forum/showthrea...ll=1#post13448
Code:
' _1. I want to create 5 tabs (Sheets) on the basis of these 5 names. (Now the workbook will have 6 tabs, including Master Sheet) https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445
Sub AddWorksheetsfromListOfNames2() ' https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445 https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
For Cnt = 1 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 1 ( Column A )
Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
Let ActiveSheet.Name = arrNmes(Cnt, 1)
Next Cnt
Bed:
Let Application.EnableEvents = True
End Sub ' (Now the workbook will have 6 tabs, including Master Sheet)
Sub AddHypolinkToWorksheet() ' https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2
Rem 2 Add hyperlinks
Ws1.Hyperlinks.Delete
Dim Cnt
For Cnt = 1 To Lr1 ' ='F:\Excel0202015Jan2016\OffenFragensForums\AllenWyatt\[DynamicWorksheetNamesLinkHideBasedOnCellValue.xlsm]RAHIM'!$A$1
Dim Paf As String: Let Paf = "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]" & arrNmes(Cnt, 1) & "'!$A$1"
' Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:="='" & arrNmes(Cnt, 1) & "'!A1", ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:=Paf, ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Next Cnt
Bed: ' error handling code section.
Let Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
Set Ws1 = Me
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim Rng As Range
Set Rng = Ws1.Range("A1:A" & Lr1 & "")
If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or Nothing if there are no common cells. So, in this example, we would have Nothing if our selection ( which VBA supplies in Target ) , did not cross our names list ' https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
Dim Rw As Long
Let Rw = Target.Row
If Target.Value = "" Then ' 5. If I delete the content of A1 (ANUJ), i.e, if cell A1 is blank, the corresponding sheet "ANUJ" should hide automatically.
ThisWorkbook.Worksheets.Item(Rw + 1).Visible = False
Exit Sub
Else
ThisWorkbook.Worksheets.Item(Rw + 1).Visible = True
Let ThisWorkbook.Worksheets.Item(Rw + 1).Name = Target.Value ' In the list, each row number corresponds to one less than the item number of our worksheets made from that list
End If
Else
' changed cell was not in Student name list
End If
'
Call AddHypolinkToWorksheet
End Sub
Share ‘DynamicWorksheetNamesLinkHideBasedOnCellValu e. : https://app.box.com/s/louq07ga6uth1508e572l7zr9fakont9
Reply With Quote
SOLVED
Bookmarks