Hi Team

Workbook has anywhere from 30 to 40 sheets at any given time, of which approx that 25 - 30 require formatting.

As there are sheets that cannot be changed I reckon using the VBA.Sheet.name( Sheet(15) to Sheet(40) ) rather than using ( For each Sheet ).

The range for each of these sheets is exactly the same. A10:O28 ( row 10 = headings ).

Currently, we are doing this manually and it takes anything up to an hour or more to do, so looking for the magic button to do it in a blink.

Step .1 Filter in ascending order ( this part is easy )

Step .2 ( The not so easy part. ) In-as-much as all the columns will have data, the rows may vary from 11 to 28.

Column A = Reference No ( could be 1 row or 6 with the same No. )

Now comes the tricky part.

I would like, so that at the end of each Reference No. in Column "A" the Bottom Border be double-lined from Columns ("A" to "O"), then continue on with the next reference No. and so on.

Then, when it gets to the row that is blank, delete the row ( could be 17 blank rows or a mere 1 )

Nut buster I know, any thoughts or suggestions welcomed.

TIA
Mark.

Oops.

Forgot to add which Column is filtered ( F ).

Hmm...

Hi Team

Workbook has anywhere from 30 to 40 sheets at any given time, of which approx
that 25 - 30 require formatting.

As there are sheets that cannot be changed I reckon using the VBA.Sheet.name(
Sheet(15) to Sheet(40) ) rather than using ( For each Sheet ).

I use a Const string containing sheetnames that do not get processed...

Const sExclShts$ = "sh1,sh2,sh4,sh7"

For Each sh In ActiveWorkbook.Sheets
If Not InStr(sExclShts, sh.Name) Then
'//process it
End If
Next 'sh

...where sExclShts$ contains the sheetnames not to be processed.

Another approach I use (since sheetnames can be changed during runtime) is to
store a 'tag' as a local scope defined name on all sheets that get some sort of
action taken...

Name: "uiProcess"
RefersTo: "=FormatData"

...and use Application.Evaluate instead of InStr in the loop.

The range for each of these sheets is exactly the same. A10:O28 ( row 10 =
headings ).

Currently, we are doing this manually and it takes anything up to an hour or
more to do, so looking for the magic button to do it in a blink.

Step .1 Filter in ascending order ( this part is easy )

...and so you can manage this yourself???

Step .2 ( The not so easy part. ) In-as-much as all the columns will have
data, the rows may vary from 11 to 28.

Column A = Reference No ( could be 1 row or 6 with the same No. )

Now comes the tricky part.

I would like, so that at the end of each Reference No. in Column "A" the
Bottom Border be double-lined from Columns ("A" to "O"), then continue on
with the next reference No. and so on.

Not understanding how the Reference No's will be contiguous if you Filter on
Col "F"!


IMO:
If your list is contiguous then just read 1 row ahead to see where the change
occurs. Use a For...Next loop so you can use its counter to check the next
row...

Dim n&, vData
vData = ActiveSheet.UsedRange

For n = 10 To 28
If Not vData(n + 1, 1) = vData(n, 1) Then
With Rows(n + 1)
.RowHeight = .RowHeight * 1.5
End With
End If
Next 'n

...where you can apply whatever other formatting you like to the 'change' row
instead of underlining the prior row.

Then, when it gets to the row that is blank, delete the row ( could be 17
blank rows or a mere 1 )

Why are there blanks?

Unless I need a subtotals row between differing records, I typically create a
'visual' separation using RowHeight so the data persists as contiguous since
it's highly likely the table the data is getting added to is a named dynamic
range.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry

I had a play with your code and it seems to work, but!!!!

It keeps stopping at the same line as I mentioned in the other code you supplied for another project I had with the Error 9 Subscript out of range..

If Not vData(n + 1, 1) = vData(n, 1) Then

This is the code thus far. I have still yet to get to the part where it deletes blank rows.

Sub Sheet_Magic()

Const sExclShts$ = "'TMS DATA', 'SUPPORT DATA', 'TMS AUDIT', 'TENDER AMOUNTS', 'ROUTE SUMMARY', 'RUN SHEET TEMPLATE', OVERWEIGHT, 'COMMIT LOG', 'TENDER LOG'"

For Each sh In ActiveWorkbook.Sheets
If Not InStr(sExclShts, sh.Name) Then

Dim n&, vData
vData = ActiveSheet.UsedRange

With ActiveSheet
.Range(Cells(11, 1), Cells(26, 14)).Sort key1:=.Cells(4, 6)
End With

For n = 10 To 26
If Not vData(n + 1, 1) = vData(n, 1) Then
With Rows(n + 1).Columns("A:N").Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End If
Next n

End If
Next sh

End Sub

Any thoughts as to why it keeps halting on the vData line..??

Look forward to hearing from you soon.

Many thanks again.
Mark.

Any thoughts as to why it keeps halting on the vData line..??

Oops.., my bad! That happens at the last row (UBound(vData)) because there is
no +1 element. Revise as follows...

....
For n = 10 To 28
On Error GoTo Cleanup
If Not vData(n + 1, 1) = vData(n, 1) Then
With Rows(n + 1).Columns("A:N").Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End If
Next n

Cleanup:

End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Perhaps a better approach...

For n = 10 To 28
If Not Cells(n + 1, 1) = vData(n, 1) Then
With Rows(n + 1).Columns("A:N").Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End If
Next n

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Thank you once again Garry.

I decided to go back to the drawing board and the melting-pot and cam up with the following which works to a degree as it gives me the end result I'm looking for but with 2 issues.

1. It keeps flickering & looping over the same range on the same page.
2. It does not cycle through all the other sheet, just the active one.

Apart from that, it looks promising.

Sub Sheet_Magic()

Dim rng, c
Dim sh As Worksheet

Set rng = ActiveSheet.Range("A11:A26")

Const sExclShts$ = "'TMS DATA', 'SUPPORT DATA', 'TMS AUDIT', 'TENDER AMOUNTS', 'ROUTE SUMMARY', 'RUN SHEET TEMPLATE', OVERWEIGHT, 'COMMIT LOG', 'TENDER LOG'"

For Each sh In ActiveWorkbook.Sheets
If Not InStr(sExclShts, sh.Name) Then


With ActiveSheet
.Range(Cells(11, 1), Cells(26, 14)).Sort key1:=.Cells(4, 6)
End With

For col = 1 To 13
Select Case ActiveSheet.Cells(10, col).Value
Case "Route Ref"
myRef = col
End Select
Next col
For i = 11 To 26
myRef = Cells(i, "A").Value
If myRef < Cells(i + 1, "A").Value Then
Range(Cells(i, 1), Cells(i, 14)).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End If
For Each c In rng
If c = "" Then
With c
.EntireRow.Delete
End With
End If
Next c
Next i
End If
Next sh

End Sub

Really looking forward to your thoughts.

Cheers
Mark.

Also Garry

I may have mis-presented / explained badly what I was attempting to achieve as I was not looking for a blank row to separate each group, merely a double-line border.This is why I changed the .RowHeight to .XlBorderEdge.

Cheers
Mark.

Hi Garry

Thank you for your time on this.

With respect to the sheet layout.

The Reference No. is the order in which we will call into an area to see multiple clients, Column "F" is the time when we will drop in.

One area may have 5 clients, and the next 1 or 2.

I use the double-line border to help our people differentiate between one group to another, it's an aesthetic thing.

As for empty rows, each sheet is preformatted to include Row 11 to 28. Some teams may have more clients to call into than others given the distance travelled.

Again, with respects to deleting the unwanted blank rows, it's more to do with wasting toner printing something if you don't have to. It may seem trivial and skin-flint, but when we're talking about thousands of sheets, it soon adds up.

Garry & Claus

Just wanted to say thank you to both of you for your guidance. I decided to forego the Exclusion list and went with a table list.

Ran it tonight at work and it went very well. Here is what I ended up with just in case anyone in the future may look at doing something similar.

Sub Sheet_Magic()

Dim rng, c
Dim RSrng, rCell
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set RSrng = Sheets("Route Summary").Range("A5:A43")

For Each rCell In RSrng

On Error Resume Next
If Not rCell.Value Is Nothing Then Sheets("" & rCell).Activate
On Error GoTo 0

With ActiveSheet
Set rng = .Range("A10:O26")
rng.Borders(xlEdgeBottom).LineStyle = xlNone
rng.Sort key1:=.Range("F10"), order1:=xlAscending, Header:=xlYes

For i = 11 To 26
If .Cells(i + 1, "A") < .Cells(i, "A") Then
With .Range(.Cells(i, 1), .Cells(i, 14))
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End With
End If
Next
For i = 26 To 11 Step -1
If Len(.Cells(i, 1)) = 0 Then
.Rows(i).Delete
End If
Next
End With
Next rCell

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub