Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Other Formats In Conditional Formatting 1

Status
Not open for further replies.

APElliott

Technical User
Jul 9, 2002
165
GB
Hello,

I recently wrote a bit of code to format a Pivot Table, because every time I changed a Field the formatting changed (I even had the correct boxes check so this would happen , but it did).

Anyway the trouble is the code took ages (for what it was doing). Simple changing borders, alinement, wrap text and formatting to currency.

I managed to omitted the borders from the code by uses of conditional formatting.

My question is: Can you write I code that would automatically change the format in column L to £ currency, aline to xlRight on the horizontal and xlBottom on the vertical.

If so how and where do you put it!

Cheers for any help!

Andrew [afro]
 
Andrew,

Macro record it. Then clean it up -- we can help.

What do you mean, where to put it? In a module. Run it from a command button click event. OR if you're on the source data sheet changing data and then you activate the pivot table sheet, use the Worksheet_Activate event.

BTW, include the PivotTable.RefreshTable method in the event call.

:)

Skip,
Skip@TheOfficeExperts.com
 
Hi Skip,

I was hoping that rather than having to click a command button it would just happen like the built in conditional formats do. Is there a place that I could put something that would make it happen this way?

Here is a small selection:

[A6:D65536].Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
[A3:D5].Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
[e:e].Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
[f:f].Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
[j:eek:].Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G:L,O:O").Select
Selection.NumberFormat = "£#,##0.00_);[Red](£#,##0.00)"
[e3:e5].Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
[f3:f5].Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Cheers Skip

Andrew[afro]

PS My collegue (Stripe) hasn't stopped jumping around!
 
Tell me how your application works -- ie what is the sequence of events. how do we know when the formatting should take place? What EVENT should trigger the reformatting?

Skip,
Skip@TheOfficeExperts.com
 
Hi Skip,

Here's the code that Stripe's been working on today!

My bit of Formatting is insert in the middle:

'Run Format Macro
Application.Run "BoQPrintsFormat"

Here it is:

Sub PrintAllEnquires()
Application.ScreenUpdating = False
Sheets("BoQ Prints").Select
Dim R As Long
'Loop till R = 62
For R = 6 To 62
'Cells(RowNumber,ColNumber)
If Cells(R, 18).Value > 0 Then
Cells(1, 16).Value = Cells(R, 18).Text
Application.ScreenUpdating = True
Application.ScreenUpdating = False

'Show All in Sub Ref Column
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
With pit
.Visible = True
End With
Next

'Show the Sub Ref in Cell P1 now named "SelectEnquiry"
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
With pit
If .Value = [SelectEnquiry].Value Then
.Visible = True
Else
.Visible = False
End If
End With
Next

'Show All in theMarkup Column
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
.PivotItems("(blank)").Visible = True
.PivotItems("0").Visible = True
End With

Application.ScreenUpdating = False

'Refresh the data
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Application.ScreenUpdating = False
'Show All in Sub Ref Column again
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
pit.Visible = True
Next
Application.ScreenUpdating = False
'Show the Pages only in the Markup column
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
.PivotItems("(blank)").Visible = False
.PivotItems("0").Visible = False
End With

'Run Format Macro
Application.Run "BoQPrintsFormat"

'Print the enquiry
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

Next R

[a6].Select
Application.ScreenUpdating = True
End Sub

Hope this explains

Cheers,

Andrew [afro]
 
Drew

You did not answer my questions.

I was NOT asking about CODE.

I was asking about the EVENTS that the user goes thru prior to what you want to happen with code.

Skip,
Skip@TheOfficeExperts.com
 
Sorry Skip I thought the Code showed the Events.

If the User was doing it manually he would be choosing different data in the Sub Ref field. When this happen all choosen formats are lost!

That's all!

Hope this is what you mean

Cheers,

Andrew
 
Skip,
I think he means he wants the macro to run when the pivot table is done updating. I can't help - never used pivot tables.


Rob
[flowerface]
 
Hello Rob, Skip,

That's right I want the macro to run when the pivot table is done updating, but I've already got a macro running that does the formatting. I wondered if there was a VB way of automatically adding these extra formats!

Sorry for the delayed response - had to go home [sleeping2]

Thanks

Andrew [ghost] [pumpkin]
 
Cheers Skip.

I've done that it just seems a bit slow.

My macro all seem to go a bit slow - could it be because I,m running them over a network?

I've added Application.screenupdating = False etc to them, but macro that should take 1 or 2 seconds are taking 10 to 20 seconds.

Thanks,

Andrew [pumpkin]
 
Cheers Skip,

I've changed it a lot this morning. I've tried to delete any bits that I think I might not need:

Here the revised code rather the old ones:

Sub BoQFormat()
Application.ScreenUpdating = False
Sheets("BoQ Prints").Select

LRow = Range("a65536").End(xlUp).Row
LCol = Range("o3").Column
'Range A6 TO D-last row
Range(Cells(6, 1), Cells(LRow, 4)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With
'Range A3 TO D5
Range(Cells(3, 1), Cells(5, 4)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
End With
Range(Cells(3, 5), Cells(LRow, 5)).HorizontalAlignment = xlRight
Range(Cells(3, 6), Cells(LRow, 6)).HorizontalAlignment = xlLeft
Range(Cells(3, 12), Cells(LRow, LCol)).HorizontalAlignment = xlRight

Range(Cells(3, 7), Cells(LRow, 12)).NumberFormat = "£#,##0.00_);[Red](£#,##0.00)"
Range(Cells(3, LCol), Cells(LRow, LCol)).NumberFormat = "£#,##0.00_);[Red](£#,##0.00)"
Range(Cells(3, 5), Cells(5, 5)).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
Range(Cells(3, 6), Cells(5, 6)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range(Cells(3, 7), Cells(5, 11)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range(Cells(3, 12), Cells(5, 15)).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
[L:O].EntireColumn.AutoFit
ActiveSheet.Outline.ShowLevels ColumnLevels:=1
Range(Cells(6, 1), Cells(LRow, LCol)).Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
With ActiveSheet.PageSetup
.LeftFooter = ("BILLS OF QUANTITIES")
.RightFooter = ([p1]) + (". ") + ([q1]) + (" ENQUIRY")
.CenterHorizontally = True
.FitToPagesWide = 1
End With

[a6].Select
Application.ScreenUpdating = True
End Sub

Sub PrintAllEnquires()
Application.ScreenUpdating = False
Sheets("BoQ Prints").Select

'Blank Out any rates from BoQ
Range("L6:L65536,O6:O65536").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:="0"
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlBottom).LineStyle = xlNone
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = 2
Selection.FormatConditions(2).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlBottom).LineStyle = xlNone
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""(blank)"""
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlBottom).LineStyle = xlNone

Dim R As Long
'Loop till R = 65
For R = 6 To 65
'Cells(RowNumber,ColNumber)
If Cells(R, 18).Value > 0 Then
Cells(1, 16).Value = Cells(R, 18).Text
Application.ScreenUpdating = True
Application.ScreenUpdating = False

'Show All in Sub Ref Column
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
With pit
.Visible = True
End With
Next

'Show the Sub Ref in Cell P1 now named "SelectEnquiry"
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
With pit
If .Value = [SelectEnquiry].Value Then
.Visible = True
Else
.Visible = False
End If
End With
Next

'Show All in theMarkup Column
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
.PivotItems("(blank)").Visible = True
.PivotItems("0").Visible = True
End With

Application.ScreenUpdating = False

'Refresh the data
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Application.ScreenUpdating = False
'Show All in Sub Ref Column again
For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
pit.Visible = True
Next
Application.ScreenUpdating = False
'Show the Pages only in the Markup column
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
.PivotItems("(blank)").Visible = False
.PivotItems("0").Visible = False
End With

'Run Format Macro
Application.Run "BoQPrintsFormat"



'Print the enquiry
ActiveWindow.SelectedSheets.PrintOut Copies:=Cells(R, 20).Value, Collate:=True
End If

Next R
Range("L6:L65536,O6:O65536").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""(blank)"""
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(1).Borders(xlBottom).LineStyle = xlNone
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = xlAutomatic
Selection.FormatConditions(2).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(2).Borders(xlBottom).LineStyle = xlNone
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="0"
Selection.FormatConditions(3).Font.ColorIndex = xlAutomatic
Selection.FormatConditions(3).Borders(xlLeft).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlRight).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlTop).LineStyle = xlNone
Selection.FormatConditions(3).Borders(xlBottom).LineStyle = xlNone
[a6].Select
Application.ScreenUpdating = True
End Sub

Thanks Skip

Andrew [pumpkin]
 
Drew,

My cleanup effort -- and some questions...

In PrintAllEnquires you

1 format conditions

2. loop 60 times on rows 6 to 65
Why are you doing all that pivot table processing each time
then you run the BoQPrintsFormat 60 times

3. format conditions again

You need to look at what happening within your loop -- looks to me like ALOT os stuff is being processed over and over needlessly.
Code:
Sub BoQFormat()
    Application.ScreenUpdating = False
'    Sheets("BoQ Prints").Select
    
    LRow = Range("a65536").End(xlUp).Row
    LCol = Range("o3").Column
    'Range A6 TO D-last row
    
    With Range(Cells(6, 1), Cells(LRow, 4))
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
    End With
    'Range A3 TO D5
    
    With Range(Cells(3, 1), Cells(5, 4))
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
    End With
    Range(Cells(3, 5), Cells(LRow, 5)).HorizontalAlignment = xlRight
    Range(Cells(3, 6), Cells(LRow, 6)).HorizontalAlignment = xlLeft
    Range(Cells(3, 12), Cells(LRow, LCol)).HorizontalAlignment = xlRight
     
    Range(Cells(3, 7), Cells(LRow, 12)).NumberFormat = "£#,##0.00_);(£#,##0.00)"
    Range(Cells(3, LCol), Cells(LRow, LCol)).NumberFormat = "£#,##0.00_);(£#,##0.00)"
    
    With Range(Cells(3, 5), Cells(5, 5))
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With
    
    With Range(Cells(3, 6), Cells(5, 6))
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    
    With Range(Cells(3, 7), Cells(5, 11))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    With Range(Cells(3, 12), Cells(5, 15))
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With
    [L:O].EntireColumn.AutoFit
    With ActiveSheet
        .Outline.ShowLevels ColumnLevels:=1
    
        .PageSetup.PrintArea = Range(Cells(6, 1), Cells(LRow, LCol)).Address
        With .PageSetup
        .LeftFooter = ("BILLS OF QUANTITIES")
        .RightFooter = ([p1]) + (". ") + ([q1]) + (" ENQUIRY")
        .CenterHorizontally = True
        .FitToPagesWide = 1
        End With
    End With
    [a6].Select
    Application.ScreenUpdating = True
End Sub

Sub PrintAllEnquires()
    Application.ScreenUpdating = False
    With Sheets("BoQ Prints").Range("L6:L65536,O6:O65536")

'Blank Out any rates from BoQ
   
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="0"
        With .FormatConditions(1)
            .Font.ColorIndex = 2
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
            Formula1:="0"
        With .FormatConditions(2)
            .Font.ColorIndex = 2
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="=""(blank)"""
        With .FormatConditions(3)
            .Font.ColorIndex = 2
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
    End With
    Dim R As Long
    'Loop till R = 65
    For R = 6 To 65
        'Cells(RowNumber,ColNumber)
        If Cells(R, 18).Value > 0 Then
            Cells(1, 16).Value = Cells(R, 18).Text
    '        Application.ScreenUpdating = True
'            Application.ScreenUpdating = False
        
'Show All in Sub Ref Column
            For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
              pit.Visible = True
            Next
    
    'Show the Sub Ref in Cell P1 now named "SelectEnquiry"
            For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
              With pit
                If .Value = [SelectEnquiry].Value Then
                  .Visible = True
                Else
                  .Visible = False
                End If
              End With
            Next
    
'Show All in theMarkup Column
            With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
                .PivotItems("(blank)").Visible = True
                .PivotItems("0").Visible = True
            End With

            Application.ScreenUpdating = False
    
            'Refresh the data
            ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
            Application.ScreenUpdating = False
            'Show All in Sub Ref Column again
            For Each pit In ActiveSheet.PivotTables("PivotTable2").PivotFields("Sub Ref").PivotItems
                pit.Visible = True
            Next
            Application.ScreenUpdating = False
            'Show the Pages only in the Markup column
            With ActiveSheet.PivotTables("PivotTable2").PivotFields("Markup")
                .PivotItems("(blank)").Visible = False
                .PivotItems("0").Visible = False
            End With
        
           'Run Format Macro
            Application.Run "BoQPrintsFormat"
       
       
       
            'Print the enquiry
            ActiveWindow.SelectedSheets.PrintOut Copies:=Cells(R, 20).Value, Collate:=True
        End If
    
    Next R
    With Sheets("BoQ Prints").Range("L6:L65536,O6:O65536")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""(blank)"""
        With .FormatConditions(1)
            .Font.ColorIndex = 2
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="0"
        With .FormatConditions(2)
            .Font.ColorIndex = xlAutomatic
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
            Formula1:="0"
        With .FormatConditions(3)
            .Font.ColorIndex = xlAutomatic
            .Borders(xlLeft).LineStyle = xlNone
            .Borders(xlRight).LineStyle = xlNone
            .Borders(xlTop).LineStyle = xlNone
            .Borders(xlBottom).LineStyle = xlNone
        End With
    End With
    [a6].Select
    Application.ScreenUpdating = True
End Sub


Skip,
Skip@TheOfficeExperts.com
 
Hi Skip,

Firstly the first format conditions changes the font colour so the text isn't printed, it also makes sure there are no borders!

Then it loops through Rows 6 to 65. On each of the loops it is changing the data in the Sub Ref and then the Markup field.

Each time it does this some of the formatting is lost.

To get round this I have to run the BOQFormat macro each time it loops.

And then finally once it as finished looping it reverts the font back to Black!

Hope this explains!

Cheers Skip

Andrew [pumpkin]
 
Yeah it's lost on refresh even though I have the correct Table Options check.

Does pivottable stuff not need to be in the loop?

Stripe and I are novices at coding, so i'm affraid some of are codes are going to be a bit long winded

Cheers

Andrew [pumpkin]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top