Forum Discussion
Excel VBA Inserting Links
Hey SergeiBaklan and HansVogelaar - either of you have ideas on what i'm missing? Trying to get the "create new user" (V2) macro to end with adding a hyperlink in cell A of the user list tab, which ...
Here you go:
Sub CreateNewUserTabCCCCCV2()
Dim WBK As Workbook
Dim WSH As Worksheet
Dim RNG1 As Range
Dim RNG2 As Range
Dim ADR1 As String
Dim ADR2 As String
Dim WSN As Worksheet
Dim ID As Long
Dim RowStart As String
Dim RowEnd As String
Dim EndAddress As String
Dim StartAddress As String
Dim StartMonth As String
Dim StartRow As String
Dim LR As Long
'Save and close other workbooks
For Each WBK In Application.Workbooks
If Not (WBK Is Application.ThisWorkbook) Then
WBK.Close SaveChanges:=True
End If
Next WBK
'Find New Users on Productivity Tab
Application.ScreenUpdating = False
Set WBK = ThisWorkbook
Set WSH = WBK.Worksheets("User List")
With WSH.Range("F:F")
Set RNG1 = .Find(What:="No", LookIn:=xlValues, Lookat:=xlWhole)
If Not RNG1 Is Nothing Then
ADR1 = RNG1.Address
Set RNG2 = RNG1.Offset(0, -5)
ADR2 = RNG2.Address
Do
If RNG2.Value <> "" Then
ID = RNG2.Value
StartMonth = RNG1.Offset(0, 1).Value
'Copy template to end of sheets
WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count)
Set WSN = WBK.Worksheets(WBK.Worksheets.Count)
'Update ID Cell and Tab Name on new sheet
WSN.Range("B8").Value = ID
WSN.Name = CStr(ID)
'Identify future month rows to remove
WSN.Range("A11") = RowStart
EndAddress = Cells(WorksheetFunction.Match(StartMonth, Range("A:A"), 0), 1).Address
RowEnd = Range(EndAddress).Row
WSN.Range("A11:A" & RowEnd - 1).EntireRow.Delete
'Identify pre-start month rows to remove
StartAddress = Cells(WorksheetFunction.Match(StartMonth, Range("A:A"), 0), 1).Address
RowStart = Range(StartAddress).Row
LR = Cells(Rows.Count, 1).End(xlUp).Row
WSN.Range("A" & RowStart + 1 & ":A" & LR).EntireRow.Delete
'Update New Sheet Caluclation References
WSN.Range("B9").Formula = "=SUM($AL$11:$AL$33)"
WSN.Range("G9").Formula = "=SUM($AO$11:$AO$33)"
WSN.Range("J9").Formula = "=SUM($AM$11:$AM$33)"
WSN.Range("N9").Formula = "=SUM($AN$11:$AN$33)"
WSN.Range("Q9").Formula = "=SUM($AK$11:$AK$21)"
WSN.Range("T9").Formula = "=SUM($AI$11:$AI$33)"
WSN.Range("Y9").Formula = "=SUM($AH$11:$AH$33)"
WSN.Range("AB9").Formula = "=SUM($AJ$11:$AJ$33)"
WSN.Range("B1").Formula = "=B9"
WSN.Range("B3").Formula = "=SUM(G9,J9,N9)"
WSN.Range("B5").Formula = "=Q9"
'Update User List to create links to newly created user tabs
WSH.Hyperlinks.Add Anchor:=RNG2, Address:="", SubAddress:="'" & WSN.Name & "'!A1"
End If
RNG1.Value = "Yes"
Set RNG1 = .Find(What:="No", Lookat:=xlWhole)
If RNG1 Is Nothing Then Exit Do
Loop Until RNG1.Address = ADR1
End If
End With
WSH.Activate
Application.ScreenUpdating = True
End SubHansVogelaar stupid question time. It seems it works beautifully if i only have 1 new user to add. If i have more than one it behaves oddly, and errors on creating the second new user sheet. Behavior is as follows:
1. First new sheet created, cell b8 named, sheet named, and all un needed rows removed.
2. Next copy of "Template" created, but cell B8 is named the name of the sheet created in bullet 1. at the point the WSN.Name fires again, the macro errors, advising, best as i can translate, the sheet name is already taken by the previously created tab.Hope that makes sense, and can be recreated with the copy i'm attaching here. Again, this logic you had above, is now labelled the CreateNewV2.
I had to move three lines into the Do ... Loop.
Sub CreateNewUserTabCCCCCV2() Dim WBK As Workbook Dim WSH As Worksheet Dim RNG1 As Range Dim RNG2 As Range Dim ADR1 As String Dim ADR2 As String Dim WSN As Worksheet Dim ID As Long Dim RowStart As String Dim RowEnd As String Dim EndAddress As String Dim StartAddress As String Dim StartMonth As String Dim StartRow As String Dim LR As Long 'Save and close other workbooks For Each WBK In Application.Workbooks If Not (WBK Is Application.ThisWorkbook) Then WBK.Close SaveChanges:=True End If Next WBK 'Find New Users on Productivity Tab Application.ScreenUpdating = False Set WBK = ThisWorkbook Set WSH = WBK.Worksheets("User List") With WSH.Range("F:F") Set RNG1 = .Find(What:="No", LookIn:=xlValues, Lookat:=xlWhole) If Not RNG1 Is Nothing Then Do ADR1 = RNG1.Address Set RNG2 = RNG1.Offset(0, -5) ADR2 = RNG2.Address If RNG2.Value <> "" Then ID = RNG2.Value StartMonth = RNG1.Offset(0, 1).Value 'Copy template to end of sheets WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count) Set WSN = WBK.Worksheets(WBK.Worksheets.Count) 'Update ID Cell and Tab Name on new sheet WSN.Range("B8").Value = ID WSN.Name = CStr(ID) 'Identify future month rows to remove WSN.Range("A11") = RowStart EndAddress = WSN.Cells(WorksheetFunction.Match(StartMonth, WSN.Range("A:A"), 0), 1).Address RowEnd = WSN.Range(EndAddress).Row WSN.Range("A11:A" & RowEnd - 1).EntireRow.Delete 'Identify pre-start month rows to remove StartAddress = WSN.Cells(WorksheetFunction.Match(StartMonth, WSN.Range("A:A"), 0), 1).Address RowStart = WSN.Range(StartAddress).Row LR = WSN.Cells(WSN.Rows.Count, 1).End(xlUp).Row WSN.Range("A" & RowStart + 1 & ":A" & LR).EntireRow.Delete 'Update New Sheet Caluclation References WSN.Range("B9").Formula = "=SUM($AL$11:$AL$33)" WSN.Range("G9").Formula = "=SUM($AO$11:$AO$33)" WSN.Range("J9").Formula = "=SUM($AM$11:$AM$33)" WSN.Range("N9").Formula = "=SUM($AN$11:$AN$33)" WSN.Range("Q9").Formula = "=SUM($AK$11:$AK$21)" WSN.Range("T9").Formula = "=SUM($AI$11:$AI$33)" WSN.Range("Y9").Formula = "=SUM($AH$11:$AH$33)" WSN.Range("AB9").Formula = "=SUM($AJ$11:$AJ$33)" WSN.Range("B1").Formula = "=B9" WSN.Range("B3").Formula = "=SUM(G9,J9,N9)" WSN.Range("B5").Formula = "=Q9" 'Update User List to create links to newly created user tabs WSH.Hyperlinks.Add Anchor:=RNG2, Address:="", SubAddress:="'" & WSN.Name & "'!A1" End If RNG1.Value = "Yes" Set RNG1 = .Find(What:="No", After:=RNG1, Lookat:=xlWhole) If RNG1 Is Nothing Then Exit Do Loop Until RNG1.Address = ADR1 End If End With WSH.Activate Application.ScreenUpdating = True End Sub
