英文:
VBA nested For Loop to copy and rename a worksheet based on a variable; not working
问题
I am trying to write a sub where I loop through a column full of dates, and for each tax year in the column create a copy of a template Worksheet and rename it to the tax year.
I've got part way. The loop for finding and returning the tax year for each cell works and loops through the full range. The loop for checking if there is already a worksheet named after that tax year works and loops through the full range.
The problem occurs once I combine the loops. The dates aren't in chronological order, so the first 23 dates are for 2023, and 1 Worksheet for 2023 is created, then there are 3 dates for 2022, and 1 worksheet for 2022 is created, then the next date is for 2023, and the For loop to check the existing sheet names fails, and it tries to create another worksheet for 2023, returning the Run-Time Error '1004': That name is already taken. Try a different one. I can't work out what I'm doing wrong. Any advice is greatly appreciated.
英文:
I am trying to write a sub where I loop through a column full of dates, and for each tax year in the column create a copy of a template Worksheet and rename it to the tax year.
I've got part way. The loop for finding and returning the tax year for each cell works and loops through the full range. The loop for checking if there is already a worksheet named after that tax year works and loops through the full range.
The problem occurs once I combine the loops. The dates aren't in chronological order so the first 23 dates are for 2023 and 1 Worksheet for 2023 is created, then there are 3 dates for for 2022 and 1 worksheet for 2022 is created, then the next date is for 2023 and the For loop to check the Exiting sheet names fails and it tries to create another worksheet for 2023 returning the Run Time Error '1004': That name is already taken. Try a different one. I can't work out what I'm doing wrong.
Any advice is greatly appreciated.
Option Explicit
Sub Createtaxyears()
'I'm teaching myself so apologies for poor layout/grammar with regards to my code.
Dim cell As Range
Dim Todate As Range
Dim Sort_Table As Worksheet
Dim Template As Worksheet
Dim WSheetfound As Boolean
Dim Template As Worksheet
Dim WSheet As Worksheet
Set Todate = Range("Sorttable[To Date]")
Dim Tdate As String
Dim M As Variant
Dim I As Variant
Dim Y As Variant
Set Template = Sheets("Template")
Sheets("Sort_Table").Select 'selects source worksheet to start
For Each cell In Todate 'loop to find tax year
If Not IsEmpty(cell) Then 'avoids runnin git on empty cells
Tdate = cell.Value
M = Split(Tdate, ".") 'dd.mm.yyyy is not recognised as a date need to use split to ref
If M(1) >= 5 Then Y = M(2) + 1 ' tax year returns run from May to April
If M(1) <= 4 Then Y = M(2) 'I'll turn this into a function later
End If
For Each WSheet In ThisWorkbook.Worksheets
If WSheet.Name = Y Then
WSheetfound = True
Else
WSheetfound = False
End If
Next WSheet
If WSheetfound = False Then Template.Copy After:=Sheets(Sheets.Count)
If WSheetfound = False Then Sheets(Sheets.Count).Select 'selects last sheet to prevent sort_table being renamed.
If WSheetfound = False Then ActiveSheet.Name = (Y)
Next cell
End Sub
答案1
得分: 2
Consider using a dictionary object to determine if a sheet exists.
Option Explicit
Sub Createtaxyears()
Dim wb As Workbook
Dim wsTemplate As Worksheet, ws As Worksheet
Dim rngToDate As Range, cell As Range, FY As String
Dim arDMY, msg As String
Set wb = ThisWorkbook
Set rngToDate = wb.Sheets("Sort_Table").Range("Sorttable[To Date]")
Set wsTemplate = wb.Sheets("Template")
' build dictionary of existing sheet names
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In wb.Sheets
dict.Add ws.Name, ws.Index
Next
'loop dates to find tax year
For Each cell In rngToDate
If cell Like "##.##.####" Then ' skip non date cells
'dd.mm.yyyy is not recognised as a date need to use split to ref
arDMY = Split(cell.Value, ".")
If arDMY(1) >= 5 Then 'tax year returns run from May to April
FY = CStr(arDMY(2) + 1)
Else
FY = CStr(arDMY(2))
End If
' check if sheet doesn't exist
If Not dict.exists(FY) Then
wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = FY
dict.Add FY, 1
msg = msg & vbLf & FY
End If
End If
Next
If msg = "" Then
MsgBox "No sheets Added", vbInformation
Else
MsgBox "Sheets added for years" & msg, vbInformation
End If
End Sub
英文:
Consider using a dictionary object to determine if a sheet exists.
Option Explicit
Sub Createtaxyears()
Dim wb As Workbook
Dim wsTemplate As Worksheet, ws As Worksheet
Dim rngToDate As Range, cell As Range, FY As String
Dim arDMY, msg As String
Set wb = ThisWorkbook
Set rngToDate = wb.Sheets("Sort_Table").Range("Sorttable[To Date]")
Set wsTemplate = wb.Sheets("Template")
' build dictionary of existing sheet names
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In wb.Sheets
dict.Add ws.Name, ws.Index
Next
'loop dates to find tax year
For Each cell In rngToDate
If cell Like "##.##.####" Then ' skip non date cells
'dd.mm.yyyy is not recognised as a date need to use split to ref
arDMY = Split(cell.Value, ".")
If arDMY(1) >= 5 Then 'tax year returns run from May to April
FY = CStr(arDMY(2) + 1)
Else
FY = CStr(arDMY(2))
End If
' check if sheet doesn't exist
If Not dict.exists(FY) Then
wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = FY
dict.Add FY, 1
msg = msg & vbLf & FY
End If
End If
Next
If msg = "" Then
MsgBox "No sheets Added", vbInformation
Else
MsgBox "Sheets added for years" & msg, vbInformation
End If
End Sub
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论