We help IT Professionals succeed at work.
Get Started

FAO zorvek: Macro you provided? Need further advice!

onebadmofo
onebadmofo asked
on
709 Views
Last Modified: 2010-04-21
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

Open in new window

Comment
Watch Question
CERTIFIED EXPERT
Top Expert 2008
Commented:
This problem has been solved!
Unlock 1 Answer and 3 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant

An Experts Exchange subscription includes unlimited access to online courses.

Get Started
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE