CODEWITHSUNDEEP
vbaexcel
Summer Developer
Summer Developer

Reputation: 2086

Excel Automation Error - Formatting A Date

My code is below. I am trying to create a new sheet based on unique values in the Date column. If I don't format the date properly,

I get an invalid sheet name error, because of the /. However, when attempting to format the date to avoid this error, I get an automation error and the macro terminates at the last line that I have posted here.

Please help. :)

Sub Analyze()
Dim DateColumn As Range
Dim theDate As Range
Dim theNextDate As Range
Dim theWorksheet As Worksheet
Dim thenewWorksheet As Worksheet
Const DateColumnCell As String = "Date"
Set theWorksheet = Sheets("Main")
Set DateColumn = theWorksheet.UsedRange.Find(DateColumnCell, , xlValues, xlWhole)

'Make sure you found something
If Not DateColumn Is Nothing Then
    'Go through each cell in the column
    For Each theDate In Intersect(DateColumn.EntireColumn, theWorksheet.UsedRange).Cells
        'skip the header and empty cells
        If Not IsEmpty(theDate.Value) And theDate.Address <> DateColumn.Address Then
            'see if a sheet already exists
            On Error Resume Next
                Set thenewWorksheet = theWorksheet.Parent.Sheets(DateColumn.Value)
            On Error GoTo 0


            'if it doesn't exist, make it
            If thenewWorksheet Is Nothing Then
                Set thenewWorksheet = theWorksheet.Parent.Worksheets.Add
                thenewWorksheet.Name = Format(theDate.Value, "Long Date")

Upvotes: 0

Views: 370

Answers (1)

user1016274
user1016274

Reputation: 4209

First of all, you use the wrong value in 

    Set thenewWorksheet = theWorksheet.Parent.Sheets(DateColumn.Value)

This should be theDate.Value, not DateColumn.Value.

But to handle the invalid format error, I suggest this extension to your code: 

        Dim NewSheetName As String

        For Each theDate In Intersect(DateColumn.EntireColumn, theWorksheet.UsedRange).Cells
        'skip the header and empty cells
        If Not IsEmpty(theDate.Value) And theDate.Address <> DateColumn.Address Then
            'see if a sheet already exists
            NewSheetName = Format(theDate.Value, "yyyy-mm-dd")
            Set thenewWorksheet = Nothing
            On Error Resume Next
                Set thenewWorksheet = theWorksheet.Parent.Sheets(NewSheetName)
            On Error GoTo 0

            'if it doesn't exist, make it
            If thenewWorksheet Is Nothing Then
                Set thenewWorksheet = theWorksheet.Parent.Worksheets.Add
                thenewWorksheet.Name = NewSheetName
            End If
        End If
    Next

Use a custom format for the date to make sure all characters contained are legal in a sheet's name. Secondly, look for the same string in existing sheets' names as the new sheet's prospective name.

edit:

Fixed another bug: the pointer thenewWorksheet is tested against Nothing to see if a sheet with that name already exists. In the next loop iteration, this pointer still points to the last sheet created! So the test will always be positive after the first sheet is created. To fix, reset the pointer prior to the test.

Upvotes: 1

Related Questions