I would like to select rows in my excel sheet based on a criteria and then edit the format of other cells in the same row.
I know that I can select rows using autofilters (column n equals ""):
Sub beautify()
Dim rng As Range
Set rng = ActiveSheet.Range("F60:AJ3272")
rng.AutoFilter Field:=4, Field:=4, Criteria1:=""
End Sub
Now how do I change the font of column F of the lines that I have selected to white.
You can use VBA to change the background color of a cell using .Interior.ColorIndex = RGB(r, g, b) : red and the font color of the text inside a cell with .Font.Color = RGB(r, g, b) : red
The range to change these property on should be defined, like mentionned in your question by the column and the row you selected so say you chose column F and row 12 it should look like this:
Range("F12").Font.Color = -4142
So say you want to scroll through every row of a column, and change the color of every blank cell what you could do is :
Dim i As Long
For i = 1 To Rows.Count
'Column F is 6
If Cells(i, 6).Value = "" Then
Cells(i, 1).Interior.ColorIndex = RGB(150, 0, 0)
Next i
I made slight modifications to your code and it worked:
Sub beautify()
Dim i As Long
For i = 1 To 50
If Cells(i, 9).Value = "" Then
ActiveSheet.Range(Cells(i, 10), Cells(i, 31)).Font.Color = vbBlack
ActiveSheet.Range(Cells(i, 8), Cells(i, 8)).Font.Color = vbWhite
End If
Next i
End Sub
Related
I've been tasked to analyse a workbook where I need to isolate the data based on the colour (red or black) that the text is in relating to the rows.
I essentially need to develop a macro that will remove all the rows that contain data (text) that is 'all black' in the range (column C-J) and leave all the rows that contain at least one cell in the range (column C-J) that contains text that is 'red' (255,0,0).
The completed result should be that every row will contain at least one cell that contains red text between between Column C-J.
The data is set our as follows:
Names:
A1,B1
A2,B2 all the way to
A2000,B2000
Data (text) is set up like the following:
C1 to J1
C2 to J2 all the way to
C2000, J2000
I've found numerous codes that conditionally colour format but I can't seem to develop one that does what I want above.
Any help will be greatly appreciated.
I may as well offer another opinion, just for fun. :-)
Copy and paste the below into a new module, select the area of cells you want to run this over and then execute the macro.
Public Sub RemoveAllRowsWithBlackText()
Dim rngCells As Range, bFoundNonBlack As Boolean, lngRow As Long
Dim lngCol As Long
Set rngCells = Selection
Application.ScreenUpdating = False
With rngCells
For lngRow = .Rows.Count To 1 Step -1
bFoundNonBlack = False
For lngCol = 1 To .Columns.Count
If .Cells(lngRow, lngCol).Font.Color <> 0 And Trim(.Cells(lngRow, lngCol)) <> "" Then
bFoundNonBlack = True
Exit For
End If
Next
If Not bFoundNonBlack Then
.Cells(lngRow, lngCol).EntireRow.Delete xlShiftUp
End If
Next
End With
Application.ScreenUpdating = True
End Sub
... it's not bound to your columns, it will move with the selection you make.
You could try:
Option Explicit
Sub test()
Dim i As Long
With ThisWorkbook.Worksheets("Sheet1")
For i = 2000 To 2 Step -1
If .Range("C" & i).Value = "" And .Range("D" & i).Value = "" And .Range("E" & i).Value = "" And .Range("F" & i).Value = "" _
And .Range("G" & i).Value = "" And .Range("H" & i).Value = "" And .Range("I" & i).Value = "" And .Range("J" & i).Value = "" Then
.Rows(i).Delete
End If
Next i
End With
End Sub
You can use AutoFilter to filter by font color. It does not matter whether the color was derived by manual formatting or conditional formatting.
In your case, you are 'proofing a negative' across many columns. A helper column appears necessary. The code below cycles through columns C:J and marks the 'helper' column every time it encounters filtered rows with a red font.
Sub anyRedFont()
Dim c As Long
With Worksheets("sheet1")
'remove any AutoFilters
If .AutoFilterMode Then .AutoFilterMode = False
'insert a 'helper' column and label it
.Columns("C").Insert
.Cells(1, "C") = "helper"
'filter for red font color
With .Range(Cells(1, "C"), .Cells(.Rows.Count, "K").End(xlUp))
'cycle through columns looking for red font
For c = 2 To 9
'fliter for red font
.AutoFilter Field:=c, Criteria1:=vbRed, _
Operator:=xlFilterFontColor, VisibleDropDown:=False
'put a value into the 'helper' column
On Error Resume Next
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
Debug.Print .SpecialCells(xlCellTypeVisible).Address(0, 0)
.SpecialCells(xlCellTypeVisible) = 1
End With
On Error GoTo 0
'remove fliter for red font
.AutoFilter Field:=c
Next c
'fliter for non-blank helper column
.AutoFilter Field:=1, Criteria1:=1, VisibleDropDown:=False
End With
'Do your work with the rows containing at least one cell
'with red font here
'remove 'helper' column
'this removes the AutoFilter since the 'helper' column
'is the primary filter column at this point
'.Columns(Application.Match("helper", .Rows(1), 0)).Delete
'remove AutoFilter (manually with Data, Data Tools, Clear)
'If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
I've commented out removing the 'helper' column. The 'helper' is the primary filter column so removing it also removes the AutoFilter.
I need to highlight a cell in column B if it is less than value in column F. For example if cell B2 is 10 and F2 is 20, B2 should be red. However in column B there are blank cells i do not want these highlighted. For example B6 is blank but F6 is 10. In my code B6 become red as well.
Also how would i highlight a cell in the same row that is already highlighted. For example, if B2 is highlighted, highlight F2.
My code is below:
Sub threecf()
Dim rg As Range
Dim cond1 As FormatCondition, cond2 As FormatCondition
Set rg = Range("B2", Range("B2").End(xlDown))
'clear any existing conditional formatting
rg.FormatConditions.Delete
'define the rule for each conditional format
Set cond1 = rg.FormatConditions.Add(xlCellValue, xlLess, "=f2")
Set cond2 = rg.FormatConditions.Add(xlCellValue, xlEqual, "=isempty(f2)")
'define the format applied for each conditional format
With cond1
.Interior.Color = vbRed
.Font.Color = vbWhite
End With
With cond2
.Interior.Color = vbWhite
.Font.Color = vbWhite
End With
End Sub
As mentioned in my comment, use formulas. No need to use VBA
Easiest Way (Recommended Way)
I recommend this way because it takes into account new rows that are being added.
Select Col B
Select Home Tab | Conditional formatting | New Rule | Use a formula to determine which cells to format
Enter the formula =AND(B1<F1,B1<>"")
Select Format | Fill Tab
Set Fill color to red :)
Customized Way
Manually select cells B2 to last row in col B
Select Home Tab | Conditional formatting | New Rule | Use a formula to determine which cells to format
Enter the formula =AND(B2<F2,B2<>"")
Select Format | Fill Tab
Set Fill color to red :)
VBA Way
If you still want VBA then try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change as applicable
Set ws = Sheet1
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
With .Range("B2:B" & lRow)
.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(B2<F2,B2<>"""")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
End Sub
Go to conditional formatting --> New Rule --> Use a formula to determine which cells to format --> Paste This: =IF(AND(B2<F2,B2<>"") = TRUE,1,0)
For the F column: =IF(AND(F2>B2,F2<>"") = TRUE,1,0)
If you want a VBA solution, try it without conditional formatting:
Sub StackOverflow()
Dim x As Long
With ThisWorkbook.Sheets("Stack")
For x = 1 To .Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
If .Cells(x, 2).Value <> "" And .Cells(x, 2).Value < .Cells(x, 6).Value Then
.Cells(x, 2).Interior.Color = vbRed
.Cells(x, 6).Interior.Color = vbRed
.Cells(x, 2).Font.Color = vbWhite
.Cells(x, 6).Font.Color = vbWhite
Else
.Cells(x, 2).Interior.Pattern = xlNone
.Cells(x, 6).Interior.Pattern = xlNone
.Cells(x, 2).Font.Color = vbBlack
.Cells(x, 6).Font.Color = vbBlack
End If
Next x
End With
End Sub
Adapt the code to your needs (change the macro name, spreadsheet address and colors if you want).
I am looking for a macro to find duplicate rows in a spreadsheet. So far I have come up with this set of code:
Application.ScreenUpdating = False
For Each cell In ActiveSheet.UsedRange.Columns("A").Cells
For Each cell2 In ActiveSheet.UsedRange.Columns("A").Cells 'Loop through entire column A for each iteration in nested for loop
If Cells(y, 1).Value = Cells(z, 1).Value Then 'Duplicate value found
For icol = 1 To 19
If Cells(y, icol).Value = Cells(z, icol).Value Then 'If cell value in current row matches, highlight red
Cells(z, icol).Interior.ColorIndex = 3
End If
Next icol
End If
z = z + 1
Next cell2
y = y + 1 'Next cell
z = y + 1 'Next cell (y+1)
Next cell
Application.ScreenUpdating = True
I have approached this with nested foor loops. The macro is supposed to look for a duplicate value in column A. If found the macro then loops through that row to check if the entire row matches. Every matching cell in this row is then highlighted red. This seems to work fine in small scale when the number of rows isn't too big. However when applying this macro to a spreadsheet with 7000+ rows Excel freeze up and crashes. I suspect this has to do with the nested foor loops. Is there a faster and more practical approach to this?
Try conditional formatting instead of hard-coding the red cell fills.
Option Explicit
Sub dupeRed()
Dim lr As Long, lc As Long
With Worksheets("sheet1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range(.Cells(2, "A"), .Cells(lr, lc))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND(COUNTIF($A$1:$A1, $A2), A2=INDEX(A:A, MATCH($A2, $A:$A, 0)))"
.FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
End With
End With
End Sub
Output I'm hoping for is similar to this page: http://sub-atomic.com/~moses/acadcolors.html, but in Excel.
What we're trying to do is to tie AutoCAD colors to a cell. I want to be able to enter a color number in the cell (say color 10, which is red), and have the cell change to that color. I don't know how to do this without doing a macro. I assume it's going to be VBA of some type.
I have the RGB equivalents from the site above - I assume I can pull some type of a lookup.
I realize this can be done with a particularly nasty bit of conditional formatting, but I'd really prefer something a little more streamlined.
Help?
EDIT: UGP provided some really good code which did exactly what I needed. This is the final code I wound up using (adjusted for my sheet naming and with a bit of additional functionality).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range(Cells(1, 6), Cells(1000, 6))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
CellChanged = Target.Address 'Cell that changed
If IsNumeric(Worksheets("Master").Range(CellChanged).Value) Then
If Worksheets("Master").Range(CellChanged).Value = 0 Then
Worksheets("Master").Range(CellChanged).Interior.ColorIndex = xlNone
Worksheets("Master").Range(CellChanged).Font.Color = vbBlack
Else
Worksheets("Master").Range(CellChanged).Interior.Color =
Color(Worksheets("Master").Range(CellChanged).Value)
Worksheets("Master").Range(CellChanged).Font.Color =
textColor(Worksheets("Master").Range(CellChanged).Value)
End If
End If
End If
End Sub
Function Color(ByRef ID As Integer) As Long
Dim R, G, B As Integer
For i = 3 To 257
If ID = Worksheets("Colors").Cells(i, 1).Value Then
R = Worksheets("Colors").Cells(i, 2).Value
G = Worksheets("Colors").Cells(i, 3).Value
B = Worksheets("Colors").Cells(i, 4).Value
Color = RGB(R, G, B)
Exit For
End If
Next i
End Function
Function textColor(ByRef ID As Integer) As Long
If ID <= 9 Then
textColor = vbBlack
Else
If ID Mod 10 >= 4 Then
textColor = vbWhite
Else
textColor = vbBlack
End If
End If
End Function
Put this code in Sheet1 by opening the editor with alt+f11:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range(Cells(1, 1), Cells(1000, 1000))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
CellChanged = Target.Address 'Cell that changed
If IsNumeric(Worksheets("Sheet1").Range(CellChanged).Value) Then
Worksheets("Sheet1").Range(CellChanged).Interior.Color = Color(Worksheets("Sheet1").Range(CellChanged).Value)
End If
End If
End Sub
Function Color(ByRef ID As Integer) As Long
Dim R, G, B As Integer
For i = 2 To 256
If ID = Worksheets("Sheet2").Cells(i, 4).Value Then
R = Worksheets("Sheet2").Cells(i, 5).Value
G = Worksheets("Sheet2").Cells(i, 6).Value
B = Worksheets("Sheet2").Cells(i, 7).Value
Color = RGB(R, G, B)
Exit For
End If
Next i
End Function
It'll check for user input from Cell(1,1) to Cell(1000,1000) then it grabs the Color from Sheet2 where i put the autocad table you linked like this (copy and paste the table):
When the word "Overdue" appears in a cell (in column H), I want the name (in column A) and the date (in column F) in that row to automatically copy and paste into another worksheet (named HomePage) and appear in column C12 and E12.
I have the following code, but it's cutting and pasting the entire row. I just want a copy and paste of the name and date to my HomePage.
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Column = 8 Then
If Target.Value = "Overdue" Then
R = Target.Row
Rows(R).Cut
Worksheets("HomePage").Select
With ActiveSheet
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
.Cells(lastrow, 1).Select
.Paste
End With
End If
End If
End Sub
Since you only want two cells, why copy and paste? Just assign the values directly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long
If Target.Column = 8 Then
If Target.Value = "Overdue" Then
With Sheets("Homepage")
R = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(R, 3) = Target.Offset(0, -7) ' Column C = Column A
.Cells(R, 5) = Target.Offset(0, -2) ' Column E = Column F
End With
End If
End If
End Sub
as per your narrative
I want the name (in column A) and the date (in column F) in that row
to automatically copy and paste into another worksheet (named
HomePage) and appear in column C12 and E12.
place the following code in your worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column = 8 And .Value = "Overdue" Then
Sheets("Homepage").Range("C12").Value = Range(.row, "A")
Sheets("Homepage").Range("E12").Value = Range(.row, "F")
End If
End With
End Sub