Hello again the last time I posted a question it was resolved quite quickly.
Essentially what I am trying to do is if a row in column r says Project Complete then I want it to grey out the row from column D:BM
I was playing around with a few things but it doesn’t want to work.
The column r is also a vlookup formula to another workbook, not sure if that makes a difference.
Dim rng As Range, cell As Range
Set rng = Range("R10:R1000")
For Each cell In rng
If cell.Value = "Project Complete" Then
Range("D" & ActiveCell.Row & ":BM" & ActiveCell.Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Next cell
You can loop through the range without selection:
Sub OhYa()
Dim rng As Range, c As Range
Set rng = Range("R10:R1000")
For Each c In rng.Cells
If c = "Project Complete" Then
With Range("D" & c.Row & ":BM" & c.Row).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Next c
End Sub
Related
Sub Macro13()
'
' Macro13 Macro
'
'
Columns("B:C").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$F2=$G2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("D:E").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$D2=$E2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("F:G").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$F2=$G2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
When I do this, it seems to conditional format but I cannot work out what its highlighting. It's definitely not highlighting different values.
Looking through it seems I have the correct formulas and cell ranges, however I just cannot see where I have gone wrong.
Thanks
Compare the two columns and highlight the difference
Sub Highlight()
Dim n As Integer
Dim valE As Double
Dim valI As Double
Dim i As Integer
n = Worksheets("Sheet1").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
Application.ScreenUpdating = False
For i = 2 To n
valE = Worksheets("Indices").Range("E" & i).Value
valI = Worksheets("Indices").Range("I" & i).Value
If valE = valI Then
Else:
Worksheets("Sheet1").Range("E" & i).Font.Color = RGB(255, 0, 0)
End If
Next i
End Sub
Second Solution
Sub CompareColumns()
Dim aRng, bRng As Range
Set aRng = Range("A2:A20")
Set bRng = Range("B2:B6")
For Each aCell In aRng
For Each bCell In bRng
If aCell Is Nothing Or bCell Is Nothing Then
ElseIf aCell.Text = bCell.Text Then
aCell.Font.Color = bCell.Font.Color
aCell.Interior.Color = bCell.Interior.Color
Else
End If
Next bCell
Next aCell
End Sub
In vba Find the value in column by Color RGB(255,199, 206) and Write the single Value as "Duplicate" in next column.
Please view the snap for more understanding.
I am trying below code to highlight the Cells
and then I wanted to use new code to print "duplicate" infront of highlighted cells .
Can you please guide me .
Sub Highlight_Duplicate_Value()
Columns("AD:AD").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
End Sub
Thank You
Something like this? Note this only checks interior color.
Sub colorcheck()
Dim Checkrange As Range
Dim cell As Range
lastrow = ActiveSheet.Cells(Rows.Count, "AD").End(xlUp).Row
Set Checkrange = ActiveSheet.Range("AD1:AD" & lastrow)
For Each cell In Checkrange
If cell.DisplayFormat.Interior.Color = 13551615 Then
cell.Offset(0, 1).Value = "Duplicate"
End If
I am working on a macro that copies, pastes, and then creates templates forms of various sizes. Before the macro saves the template sheet as a separate file, I have it searching through a range - typically through D14:G end of data range - and highlights blank cells in a custom color. However, I have one very specific use case where there are no blank cells within the range (D14:G16), so it has been selecting all blank cells below this range (A17 to end of sheet). Can anyone help me work past this? Below is the excerpt from the macro that highlights the blankcells:
Set rLastCell = Sheets("Diversity Form").Cells.find(What:="*", After:=Sheets("Diversity Form").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
'ColumnLetter2 = Split(Cells(1, rLastCell.Column).Address, "$")(1)
lCol = Sheets("Diversity Form").Cells(Rows.count, 4).End(xlUp).Row
'Dim ColumnLetter As String
'color only blank cells
For h = 4 To 7
ColumnLetter = Split(Cells(1, h).Address, "$")(1)
Let item = ColumnLetter & "14:G" & lCol
Sheets("Diversity Form").Range(item).SpecialCells(xlCellTypeBlanks).Select
On Error Resume Next
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Next
No need to loop here, or to mess with column letters, or to Select.
Use WorksheetFunction.CountBlank first to test if there are any blanks.
With Sheets("Diversity Form")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
Dim checkRange As Range
Set checkRange = .Range(.Cells(14, 4), .Cells(lastRow, 7)) ' Or .Range("D14:G" & LastRow)
End With
If WorksheetFunction.CountBlank(checkRange) > 0 Then
With checkRange.SpecialCells(xlCellTypeBlanks).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
End If
I have a macro in my workbook that is tied to a hotkey which highlights all columns in the currently selected row. However, it only works if one row is selected. I cant think of a way to adjust it to highlight all the rows if multiple are selected. Here is the code that I am currently using.
Sub highlight_done()
'
' highlight_done Macro
'
' Keyboard Shortcut: Ctrl+q
'
Dim r As Long
r = ActiveCell.Row
Range("A" & r & ":Y" & r).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = vbWhite
.TintAndShade = 0
End With
End Sub
Any help would be appreciated.
Perhaps like the following, using Intersect and Selection.EntireRow to get the range to be colored:
Sub highlight_done()
'
' highlight_done Macro
'
' Keyboard Shortcut: Ctrl+q
'
If Not TypeOf Selection Is Range Then Exit Sub
Dim rng As Range
Set rng = Intersect(Selection.EntireRow, Range("A:Y"))
With rng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With rng.Font
.Color = vbWhite
.TintAndShade = 0
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...)