Here goes: it needs a few .xls files in the C:\Temp directory and let'er run
Option Explicit
Dim c As Long
Dim RngB As Range
Dim i As Range
Dim wb As Workbook
Dim CancelA As Boolean
Sub ProcessData()
Dim wb As Workbook
Dim TheFile As String
Dim ThePath As String
ThePath = "C:\Temp"
Application.ScreenUpdating = False
ChDir ThePath
TheFile = Dir("*.xls")
Do While TheFile <> ""
If TheFile <> "Daily Error report MASTER.xls" Then
'MsgBox TheFile
Set wb = Workbooks.Open(ThePath & "\" & TheFile)
Call AAAProcessData
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
wb.Close
End If
TheFile = Dir
Loop
Workbooks.Open Filename:=ThePath & "\" & "Daily Error report
MASTER.xls"
Application.ScreenUpdating = True
End Sub
Sub AAAProcessData()
CancelA = False
Call DelColsSort
Call DelRows
Call Summarize
If CancelA = True Then Exit Sub
Call CleanUp
End Sub
Sub DelColsSort()
Range("A:A,B:B,D
,E:E,G:G,H:H,I:I").Delete
[F1].Value = "RC Code"
[G1].Value = "Aging"
[H1].Value = "Count"
[F1:H1].HorizontalAlignment = xlCenter
End Sub
Sub DelRows()
Set RngB = Range("B2", Range("B" & Rows.Count).End(xlUp))
RngB.Offset(, -1).Resize(, 2).Sort Key1:=Range("B2"),
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For c = RngB.Count To 1 Step -1
If Left(RngB(c), 6) <> "C0B90D" And _
Left(RngB(c), 6) <> "C0B90E" And _
Left(RngB(c), 6) <> "C0B90F" And _
Left(RngB(c), 6) <> "C0B90G" Then
RngB(c).EntireRow.Delete
End If
Next c
End Sub
Sub Summarize()
Dim FirstCell As Range
Dim LastCell As Range
Dim Dest As Range
Call SetupFinal
If IsEmpty(Range("B2").Value) Then
CancelA = True
Exit Sub
End If
Set FirstCell = [B2]
Do
Set LastCell = Nothing
For c = 1 To 1000
If Left(FirstCell.Offset(c), 6) <> Left(FirstCell, 6) Then
Set LastCell = FirstCell.Offset(c - 1)
Exit For
End If
Next c
Set Dest = Range("F2:F5").Find(What:=Left(FirstCell.Value, 6),
LookAt:=xlWhole)
Dest.Offset(, 1).Value = Application.Max(Range(FirstCell,
LastCell).Offset(, -1))
Dest.Offset(, 2).Value = Range(FirstCell, LastCell).Count
Set FirstCell = LastCell.Offset(1)
Loop Until IsEmpty(FirstCell.Value)
End Sub
Sub SetupFinal()
[F2].Value = "C0B90D"
[F3].Value = "C0B90E"
[F4].Value = "C0B90F"
[F5].Value = "C0B90G"
[F6].Value = "GTotal"
For Each i In Range("G2:H5")
i.Value = i.Value * 1
Next i
End Sub
Sub CleanUp()
Columns("F:H").Columns.AutoFit
[F2:H6].HorizontalAlignment = xlCenter
[F6].Value = "GTotal"
[G6].Value = Application.Max(Range("G2:G5"))
[H6].Value = Application.Sum(Range("H2:H5"))
[F6:H6].Font.Bold = True
End Sub
Thanks
Dave Peterson said:
How about posting the exact code that you're using?