Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #109948 > unrolled thread

Formatting multiple sheets within workbook.

Back to article view | Back to microsoft.public.excel.programming

Contents

  Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-28 03:40 -0700
    Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-28 03:42 -0700
    Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-28 10:56 -0400
      Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-29 03:40 -0700
        Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-29 11:48 -0400
          Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-29 17:46 -0400
            Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-30 03:25 -0700
              Re: Formatting multiple sheets within workbook. Claus Busch <claus_busch@t-online.de> - 2017-03-30 12:48 +0200
                Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-30 06:16 -0700
                  Re: Formatting multiple sheets within workbook. Claus Busch <claus_busch@t-online.de> - 2017-03-30 15:48 +0200
                Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-30 11:10 -0400
                  Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-31 04:03 -0700
                    Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-31 07:13 -0400
                Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-31 03:51 -0700
                  Re: Formatting multiple sheets within workbook. GS <gs@v.invalid> - 2017-03-31 07:08 -0400
      Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-29 03:52 -0700
    Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-03-29 02:43 -0700
    Re: Formatting multiple sheets within workbook. Living the Dream <noodnutt@gmail.com> - 2017-04-03 04:12 -0700

#109948 — Formatting multiple sheets within workbook.

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.

[toc] | [next] | [standalone]

#109949

Oops.

Forgot to add which Column is filtered ( F ).

[toc] | [prev] | [next] | [standalone]

#109952

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

[toc] | [prev] | [next] | [standalone]

#109956

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.

[toc] | [prev] | [next] | [standalone]

#109959

> 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

[toc] | [prev] | [next] | [standalone]

#109961

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

[toc] | [prev] | [next] | [standalone]

#109962

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.

[toc] | [prev] | [next] | [standalone]

#109963

Hi,

Am Thu, 30 Mar 2017 03:25:41 -0700 (PDT) schrieb Living the Dream:

> 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.

the monitor flickering is because of Selection.

Try:

For Each sh In ActiveWorkbook.Sheets
    If InStr(sExclShts, sh.Name) Then
        
        With sh
            .Range(.Cells(11, 1), .Cells(26, 14)).Sort key1:=.Cells(4, 10), order1:=xlAscending, Header:=xlYes
        
        For col = 1 To 13
            Select Case .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
                    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
                For Each c In rng
                    If c = "" Then
                        With c
                            .EntireRow.Delete
                        End With
                    End If
                Next c
        Next i
        End With
    End If
Next sh


Regards
Claus B.
-- 
Windows10
Office 2016

[toc] | [prev] | [next] | [standalone]

#109964

Hi Claus

For the life of me, I have no idea why, but this code has gone to shyte.

Was working relatively fine, now it keeps halting.

1. If there are no Blank rows to delete, the code halts.
( probably need an exit if criteria not met ).
2. It won't sort now
( most likely has to do with overall used range, as will not always be rows 11 to 26, sometimes more, sometimes less).
3. the double-lines don't appear as before.
( clueless as to why this has stopped working ).

Too tired to worry about it, time for bed, thank you for you effor though.

Cheers
Mark.

Sigh..Back to the drawing board again.

 

[toc] | [prev] | [next] | [standalone]

#109965

Hi Mark,

Am Thu, 30 Mar 2017 06:16:50 -0700 (PDT) schrieb Living the Dream:

> 1. If there are no Blank rows to delete, the code halts.
> ( probably need an exit if criteria not met ).
> 2. It won't sort now
> ( most likely has to do with overall used range, as will not always be rows 11 to 26, sometimes more, sometimes less).
> 3. the double-lines don't appear as before.
> ( clueless as to why this has stopped working ).

try:

For Each sh In ActiveWorkbook.Sheets
   If InStr(sExclShts, sh.Name) Then
      With sh
         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 i
      End With
   End If
Next sh


Regards
Claus B.
-- 
Windows10
Office 2016

[toc] | [prev] | [next] | [standalone]

#109966

Claus,
Mark is looking to act only on sheets NOT in the sExclShts delimited list!

Also, I've found (occasionally) some anomolies occur using nested 'With' 
constructs in respect to object refs. not sure about the why/how of it so I 
make a policy when anomolies occur to add a fully qualified ref in nested 
statements that require the 'End' statement.

Another serious issue I see here is poor variable declaration! Mark, you need 
to go into the Options dialog and checkmark the "Require variable declaration" 
opption on the 'General' tab.

-- 
Garry

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

[toc] | [prev] | [next] | [standalone]

#109972

Hi Garry

I understand your concerns with declaring, and if I was churning out this stuff for a livelihood I would probably pay more attention to it, but!

In that this is a side thing I actually don't get paid to do for my cheap-ass employer who at times gives me 5 minutes to do the impossible, I skrimp and scrape and use the melting-pot to butcher out this stuff on time.

Mostly it's for my own usage and short-term it will be from here-on as the company are currently spending millions on an entirely purpose designed and built system called Ramco to handle every conceivable corner of business activity so most of what I have done will go out with the trash.

One day I might even retire and go back to school and actually learn what it is I do with VB Excel and Access. But that's not likely to happen for a while.

Cheers
Mark.

[toc] | [prev] | [next] | [standalone]

#109974

> Hi Garry
>
> I understand your concerns with declaring, and if I was churning out this 
> stuff for a livelihood I would probably pay more attention to it, but!
>
> In that this is a side thing I actually don't get paid to do for my cheap-ass 
> employer who at times gives me 5 minutes to do the impossible, I skrimp and 
> scrape and use the melting-pot to butcher out this stuff on time.
>
> Mostly it's for my own usage and short-term it will be from here-on as the 
> company are currently spending millions on an entirely purpose designed and 
> built system called Ramco to handle every conceivable corner of business 
> activity so most of what I have done will go out with the trash.
>
> One day I might even retire and go back to school and actually learn what it 
> is I do with VB Excel and Access. But that's not likely to happen for a 
> while.
>
> Cheers
> Mark.

It would just be doing yourself a favor to require variable declaration because 
your VBE will let you know when things won't compile. Also, it saves having to 
remember variable names because intellisense will display them after typing a 
few letters and pressing Ctrl+J! You only have to check the box once and the 
VBE automatically sets that up for you thereafter!

-- 
Garry

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

[toc] | [prev] | [next] | [standalone]

#109971

Hi Claus

I bypassed the For sh and used Activesheet and ran the code individually for each of the sheet I needed foramtting and I have to say it worked very well.

Now, all that needs doing is this exclusion list and I can roll it out and not have to stress over sheet that I don't want touched.

I must be doing something wrong with Garry's Cont sh Statement in that it is either looking for the VB.name of the sheets, or the actual name on the Sheet.tab.

Either way, it made a huge difference to my night cutting around 45 minutes off this particular process.

Thank you to both you and Garry for you patience and guidance.

Cheers
Mark.

[toc] | [prev] | [next] | [standalone]

#109973

> I must be doing something wrong with Garry's Cont sh Statement in that it is 
> either looking for the VB.name of the sheets, or the actual name on the 
> Sheet.tab

I use the sheet tab name in the list. The other name you refer to is the 
'CodeName'. Again, I recommend 'tagging' the process as a local scope defined 
name like "uiProcess" and set its RefersTo for the task to be acted on for the 
sheet[s]. You can also include multiple processes if need be o long as your 
business logic is well structured to manage this!

Note that both TabName and CodeName can be changed; -in the case of custom 
CodeNames Excel may reset those to default names unexpectedly.

-- 
Garry

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

[toc] | [prev] | [next] | [standalone]

#109957

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.

[toc] | [prev] | [next] | [standalone]

#109955

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.

[toc] | [prev] | [next] | [standalone]

#109976

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

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web