Forum Discussion
Excel VBA Copy Template Worksheet and rename based on specific cells/update values of specific cells
- Aug 31, 2022
Thanks. Here you go:
Dim WBK As Workbook Dim WSH As Worksheet Dim RNG As Range Dim ADR As String Dim WSN As Worksheet Dim ID As Long 'Close and save 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 Set WBK = ThisWorkbook Set WSH = WBK.Worksheets("Prod Assembly") With WSH.Range("A:A") Set RNG = .Find(What:="No", LookIn:=xlValues, LookAt:=xlWhole) If Not RNG Is Nothing Then ADR = RNG.Address Do If RNG.Offset(0, 1).Value <> "" Then ID = RNG.Offset(0, 1).Value WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count) Set WSN = WBK.Worksheets(WBK.Worksheets.Count) WSN.Range("B2").Value = ID WSN.Name = CStr(ID) End If Set RNG = .Find(What:="No", LookAt:=xlWhole) If RNG Is Nothing Then Exit Do Loop Until RNG.Address = ADR End If End With WSH.Activate End Sub
HansVogelaar - no worries, hopefully this clarifies:
The number in A1 is the output of a CountIF formula checking the number of times the word "no" results in column A3:A... All the cells in column A from row 3 down do a check against the employee number to the tabs names present in the sheet. If the tab name is not found by the formula in A#, then the formula returns "No", indicating this is a newly added employee.
The Macro can utilize either "No" or the number of no's (counted in A1) to power the number of copies of the template to make... The current user sheets are: 123456, 234567, 345678. The new user id is 456789, and should have "no" in column A, as well as not have a worksheet named 456789.
Thanks
Joe
Thanks. Here you go:
Dim WBK As Workbook
Dim WSH As Worksheet
Dim RNG As Range
Dim ADR As String
Dim WSN As Worksheet
Dim ID As Long
'Close and save 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
Set WBK = ThisWorkbook
Set WSH = WBK.Worksheets("Prod Assembly")
With WSH.Range("A:A")
Set RNG = .Find(What:="No", LookIn:=xlValues, LookAt:=xlWhole)
If Not RNG Is Nothing Then
ADR = RNG.Address
Do
If RNG.Offset(0, 1).Value <> "" Then
ID = RNG.Offset(0, 1).Value
WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count)
Set WSN = WBK.Worksheets(WBK.Worksheets.Count)
WSN.Range("B2").Value = ID
WSN.Name = CStr(ID)
End If
Set RNG = .Find(What:="No", LookAt:=xlWhole)
If RNG Is Nothing Then Exit Do
Loop Until RNG.Address = ADR
End If
End With
WSH.Activate
End Sub
- JoeCavasinSep 04, 2022Brass Contributor
Can't thank you enough! I made a few small tweaks to help with some other tabs that will have to exist in the real world version. Only problem now is on running the "Clear User Sheets" macro, it performs perfectly, skipping all other sheets - however it is throwing the "False" error message box at completion.
Do you mind checking it out? I can't figure out what is triggering a "false" response.
- HansVogelaarSep 04, 2022MVP
The line
MsgBox sTemp = "Refreshed Scoring Template and Formulas for the following worksheets"
Displays the result of evaluating the expression
sTemp = "Refreshed Scoring Template and Formulas for the following worksheets"
Since sTemp is an empty string, the expression is not true, so MsgBox displays False. You don't need sTemp at all here, simply use
MsgBox "Refreshed Scoring Template and Formulas for the following worksheets"