FAO zorvek: Macro you provided? Need further advice!

Hello,

See related question.

zorvek kindly provided me with a macro (see related question) but I've stumbled across a problem - the macro works great the first time it is run on existing data. but, when new data is added and the macro is run again to format the data correctly, it produces a runtime error.

I added the line "On Error Resume Next" to see what the effect would be and, although no error was procuded and the new data was formatted correctly, the OLD data was deleted/overwritten :(

Is there any way to amend this macro to ignore previously changed sheets whilst maintaining the format/transposing of the original macro?

Apologies for the low point score on this one. It's all I have left :(

Public Sub CleanStatesSheets()
 
   On Error Resume Next
   Dim Worksheet As Worksheet
   Dim Results As Variant
   Dim Row As Variant
   Dim Count As Long
   Dim Category As String
   Dim Hours As String
   
   For Each Worksheet In ThisWorkbook.Worksheets
      Results = Empty
      Count = 0
      If Right(Worksheet.Name, 7) = " States" Then
         With Worksheet
            Row = Application.Match("Agent", .[A:A], 0)
            If IsError(Row) Then Exit Sub
            Do
               If Len(.Cells(Row, "C")) > 0 And IsNumeric(.Cells(Row, "C")) Then
                  Count = Count + 1
                  If IsArray(Results) Then
                     ReDim Preserve Results(1 To 6, 1 To Count)
                  Else
                     ReDim Results(1 To 6, 1 To 1)
                  End If
                  Results(1, Count) = .Cells(Row, "A")
                  Results(1, Count) = Replace(Results(1, Count), "(SSD)", vbNullString)
                  Results(1, Count) = Replace(Results(1, Count), "(VOSA)", vbNullString)
                  Results(1, Count) = Replace(Results(1, Count), "(EWH)", vbNullString)
                  Results(1, Count) = Replace(Results(1, Count), "- IOPS", vbNullString)
                  Do Until UBound(Split(Results(1, Count), Space(2))) < 1: Results(1, Count) = Join(Split(Results(1, Count), Space(2)), Space(1)): Loop
               End If
               If Len(.Cells(Row, "E")) = 0 And Len(.Cells(Row, "H")) > 0 Then
                  Category = .Cells(Row, "H")
                  Hours = .Cells(Row, "J")
               Else
                  Category = .Cells(Row, "E")
                  Hours = .Cells(Row, "G")
               End If
               If InStr(Category, "Automatic") > 0 Then
                  Results(2, Count) = CDate(Hours)
               ElseIf InStr(Category, "Lunch") > 0 Then
                  Results(3, Count) = CDate(Hours)
               ElseIf InStr(Category, "Break") > 0 Then
                  Results(4, Count) = CDate(Hours)
               ElseIf InStr(Category, "Personal") > 0 Then
                  Results(5, Count) = CDate(Hours)
               ElseIf InStr(Category, "Work") > 0 Then
                  Results(6, Count) = CDate(Hours)
               End If
               Row = Row + 1
            Loop Until Left(.Cells(Row, "A"), 15) = " Report printed"
            .UsedRange.Clear
            .[A1:F1] = Array("Agent", "Automatic", "Lunch", "Break", "Personal", "Work")
            .[A2].Resize(Count, 6) = Application.Transpose(Results)
            .[A2].Resize(Count, 6).NumberFormat = "[HH]:MM"
            .[A1:F1].EntireColumn.AutoFit
         End With
      End If
   Next Worksheet
   
End Sub

Select allOpen in new window