Is there a VBA code which can automatically grey out unused areas in Excel, similar to 'page break view', except that it doesn't show the pagenumber (and line breaks)?
I know the function page break view, but the pagenumbers are disturbing and can't be hidden. Let me know!
Thanks, both solutions below worked!
you could use:
Sub Greyout()
With ActiveSheet
With .Cells.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With
With .Range(.Range("A1"), .UsedRange).Interior
.Pattern = -4142
.PatternColorIndex = -4142
.ThemeColor = -4142
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End Sub
Just hide everything outside of the worksheet's UsedRange property.
Sub hideUnused()
With Worksheets("sheet8")
.Range(.Columns(.UsedRange.Columns.Count + 1), .Columns(.Columns.Count)).Hidden = True
.Range(.Rows(.UsedRange.Rows.Count + 1), .Rows(.Rows.Count)).Hidden = True
End With
End Sub
The actual color is going to depend on your Excel application's palette.
Related
I have recorded a macro that corrects the conditional formatting rules of a table every time they get messed up (because of adding or removing lines I suppose…)
And I put a button to activate the macro in the sheet
I need to replicate the same table in several sheets (increasing number of sheets) and I want my macro to function on all of them (not necessarily simultaneously) in addition of having this common table, most of the sheets have other tables also, but there will be 1 table that will be replicated in MOST sheets.
(Basically create a template sheet containing the table and macro button that users will replicate for each new client
Since the tables will have same number of columns and column titles, is it possible to tweak it so it works on any table where the cursor has selected a cell? Or similar?
Maybe some way of changing the ref from “bookingInfo” to “selected table”
FYI: I do not know how to write VBA at all
Here is the code I have:
Application.ScreenUpdating = False
Application.Goto Reference:="BookingInfo"
Selection.ListObject.Range.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$B4<>$B5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A5<>"""""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Pattern = xlLightDown
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$AN5=""Full PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$AN5=""Partial PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub
Any Help?
You could do it like this:
Sub CFUpdate()
Dim lo As ListObject, rng As Range
Set lo = Selection.ListObject
If lo Is Nothing Then 'is the selection in a listobject?
MsgBox "First select any cell in the Table to be updated", vbExclamation
Exit Sub 'nothing to do...
End If
Set rng = lo.DataBodyRange 'range to be formatted
rng.FormatConditions.Delete
With AddFC(rng, xlExpression, "=$B4<>$B5").Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With AddFC(rng, xlExpression, "=$A5<>""""").Interior
.Pattern = xlLightDown
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
With AddFC(rng, xlExpression, "=$AN5=""Full PMT""").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
With AddFC(rng, xlExpression, "=$AN5=""Partial PMT""").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
End With
Application.ScreenUpdating = True
End Sub
'factoring out some common steps
Function AddFC(rng As Range, fcType As XlFormatConditionType, frmla As String)
Dim fc As FormatCondition
Set fc = rng.FormatConditions.Add(Type:=fcType, Formula1:=frmla)
fc.StopIfTrue = False
Set AddFC = fc 'return the FormatCondition we just added
End Function
Pulled some of the common code out into a separate function to reduce the bulk of the code when adding each format condition.
Note you'll also need to adjust the formulas if the tables don't all start on the same row...
In Excel, I wrote this code to run a particular routine each time the Print Button is pressed. It changes the sheet color to white and changes it back after printing.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
' change color to white
Range("A6:BD53").Interior.ColorIndex = 0
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' AfterPrint_ change color back
Range( _
"G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39"). _
Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range( _
"AB15:AE15,AU14:AX14,AU15:AX15,AU16:AX16,AA17:AC17,N24:W24,E28:O32,R28:U28,X28:AB31,AV37:BD37,V40:AL40,P41:U42,V43:AL43,V45:AL45,AV43:BD44" _
).Select
Range("AV43").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.EnableEvents = True
End Sub
It works just fine if I print each sheet singularly, but doesn't if I try to print many sheets at once, i.e. if I select more sheets at one time and print them. In this case, the routine is run only for the first sheet being printed and not for the others. Anyone knows why and what I can do to correct it?
Try this use of a For loop to go through all the selected sheets:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
' change color to white
ws.Range("A6:BD53").Interior.ColorIndex = 0
ws.PrintOut Copies:=1, Collate:=True
' AfterPrint_ change color back
With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ws.Range("AV43").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next ws
Err:
Application.EnableEvents = True
End Sub
As you described in the comments you are experiencing some unusal printing behavior. You can use this less elegant version of the code above, this should circumvent your problem:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
' change color to white
ws.Range("A6:BD53").Interior.ColorIndex = 0
Next ws
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For Each ws In ActiveWindow.SelectedSheets
' AfterPrint_ change color back
With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ws.Range("AV43").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next ws
Err:
Application.EnableEvents = True
End Sub
If I try to set formatting color into a range of cell with this code:
Sub colora()
Dim rgn As Range
Set rgn = Range("E4:T8,E10:T16")
rgn.FormatConditions.Add Type:=xlExpression, Formula1:="=$W4=E$3"
rgn.FormatConditions(rgn.FormatConditions.Count).SetFirstPriority
With rgn.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399945066682943
End With
rgn.FormatConditions(1).StopIfTrue = True
rgn.FormatConditions(1).ScopeType = xlSelectionScope
rgn.FormatConditions.Add Type:=xlExpression, Formula1:="=$Z4=E$3"
rgn.FormatConditions(rgn.FormatConditions.Count).SetFirstPriority
With rgn.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
rgn.FormatConditions(1).StopIfTrue = False
rgn.FormatConditions(1).ScopeType = xlSelectionScope
End Sub
I play this macro but the result wrong, then I check the formatting function on ribbon tab I show that.
Why the range of applicable formatting change from Range("E4:T8,E10:T16")to E4?!?!
Below us the code that I want some clarification for:
'Auto format the cells when you change cell B39
If Not Intersect(Target, Range("B39")) Is Nothing Then
If InStr(1, Range("B39"), "ABC") > 0 Then
Range("B13:B18,B22,B23,B25").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B19:B21,B24,B26:B35").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
Else: Range("B13:B35").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
End If
End If
If Not Intersect(Target, Range("B57")) Is Nothing Then
If Range("B57") = "DEF" Then
Range("B13:B18,B22,B23,B25,B30,B35").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B19:B21,B24,B26,B27:B29,B31:B34").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
End If
End If
End Sub
In cell B39 and B57 I have drop down list of products produced by the company. The above code highlights the requirements to manufacture those products. When I select a SKU from B39 the code highlights the range specified. Same for B57. When I change B39 first and then change B57 the highlighted cells change, I dont want this to happen. I want the changes due to selecting a SKU from B39 to remain even after changing B57.
Hope this clarification is better.
Thank you!
Seems like the problem is that you have overlapping ranges you want to hilite/clear: you can't manage the highlighting like you're trying to when you have products with overlapping materials. What you'd need to do is clear all highlighting, then check each "target" cell to see what hilighting needs to be re-added: don't just check the one Target cell which was changed.
I moved the hiliting into a separate sub and removed any Select steps - these are typically best avoided.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B39,B57")) Is Nothing Then
Hilite Range("B13:B100"), False '<< clear *all* hiliting
'add back any required hilites
If InStr(1, Range("B39"), "ABC") > 0 Then
Hilite Range("B13:B18,B22,B23,B25"), True
End If
If Range("B57") = "DEF" Then
Hilite Range("B13:B18,B22,B23,B25,B30,B35"), True
End If
End If
End Sub
'add/remove hilighting on a supplied range
Sub Hilite(rng As Range, hilight As Boolean)
With rng.Interior
If hilight Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlNone
.PatternTintAndShade = 0
End If
End With
End Sub
I Set up a Macro that Finds the differences between the two rows and then highlights them. I want the macro to Cycle through the next two rows and do the same thing and go on until there are no more rows of data(This Number varies all the time). So the Next selection would be Rows 4:5 and it would Select the differences and highlight them and so on. How is this possible? Any help is greatly appreciated. Thank you,
FindVariance Macro
Rows("2:3").Select
Range("A3").Activate
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("F16").Select
End Sub
Try:
FindVariance Macro
For j=2 to Range("A1").End(xlDown).Row-1
i=j+1
Rows(j & ":" & i).ColumnDifferences(Range("A" & i)).Offset(1,0).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
j=j+1
Next j
End Sub
Here's my sample
Option Explicit
Sub FindVariance()
Dim last As Integer, i As Integer, r As Boolean
last = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For i = 2 To last
If i Mod 2 = 0 Then
Rows(i & ":" & i + 1).Select
r = Selection.ColumnDifferences(ActiveCell).Select
If r = True Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next i
Range("F16").Select
End Sub
it's always a good habit to:
use objects reference and avoid the use of selections
which can be deceiving and slows down the code
use full reference for ranges, up to the workbook.
to avoid point to an unwanted active sheet or workbook!
so here's my code
Sub FindVariance()
Dim j As Long
Dim nRows As Long
With ActiveSheet
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 2 To nRows Step 2
With .Rows(j).Resize(2).ColumnDifferences(.Cells(j + 1, 1)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next j
End With
End Sub
and there's still some job to do in order to catch and properly treat exceptions (uneven number of rows, empty rows...)