Format text as bold - excel

This formula colors an entire row based on a cell in that row containing a specific value.
For Each Cell In .Range("Y5:" & .Range("Y1500").End(xlDown).Address)
If .Cells(Cell.Row, 25).value = "Super Project" Then
Cell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
End If
Next
End With
How can I make the cell in column “B” also turn bold?

To bold a cell: Range.Font.Bold = True
Your target cell is in Col Y (Col 25) so to get to Col B (Col 2) you need to go backwards (offset by a value of) 23 columns resulting in:
Cell.Offset(0,-23).Font.Bold = True
The OCD side of me insists on advising you to
Indent Properly
Modify the loop range (see code)
Column Y = Column 25. No need for .Cells(Cell.Row, 25). Just analyze the variable, Cell
Last, distinguishing between Cells the Object and Cell the Variable you declared can be confusing and lead to errors. Change Cell to something like MyCell so the difference is clear.
Dim MyCell as Range
With Sheets(1) 'Some Sheet
For Each MyCell In .Range("Y5:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
If MyCell = "Super Project" Then
MyCell.EntireRow.Interior.Color = vR(WorksheetFunction.RandBetween(1, n))
MyCell.Offset(,-23).Font.Bold = True
End If
Next
End With

Related

Check if value exists in two columns in VBA and highlight them, leaving out excess duplicates in either column

I am trying to get VBA to look at values in one column, and then check if the same value exists in another column.
I am then trying to highlight the same number of cells in both columns where the same value shows up, meaning that if the same value shows up a different amount of times in one column than in the other, I need to highlight the same amount of cells in each column and leave any "excess" duplicate values without highlight.
The picture illustrates what I am trying to accomplish. EXCEL SCREENSHOT
As seen in the picture, the values have been highlighted to the degree that they show up in either column, leaving the additional duplicate values without highlight.
I tried this code but it did not work and highlighted cells that I did not expect to get highlighted. I tried to loop through the columns and ignore already highlighted cells.
Sub highlightMatchingValues()
'Declare variables
Dim cellC As Range, cellE As Range
'Loop through each cell with a value in column C
For Each cellC In Range("C:C").Cells
If Not IsEmpty(cellC) And cellC.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted
'Loop through each cell with a value in column E
For Each cellE In Range("E:E").Cells
If Not IsEmpty(cellE) And cellE.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted
If cellC.value = cellE.value Then 'check for a match
'Highlight both cells green
cellC.Interior.Color = vbGreen
cellE.Interior.Color = vbGreen
End If
End If
Next cellE
End If
Next cellC
End Sub
here comes a solution that can solve your problem
'Sheet name = sheetName
'First columns variables (column C = index 3)
Dim firstLine1 As Long
Dim lastLine1 As Long
firstLine1 = 1
lastLine1 = Worksheets("sheetName").Cells(Rows.Count, 3).End(xlUp).Row
'Second columns variables (column E = index 5)
Dim firstLine2 As Long
Dim lastLine2 As Long
firstLine2 = 1
lastLine2 = Worksheets("sheetName").Cells(Rows.Count, 5).End(xlUp).Row
'loop
For i = firstLine1 To lastLine1
For j = firstLine2 To lastLine2
If (Worksheets("sheetName").Cells(i, 3).Value = Worksheets("sheetName").Cells(j, 5)) Then
If (Worksheets("sheetName").Cells(j, 5).Interior.Color <> vbGreen) Then
Worksheets("sheetName").Cells(i, 3).Interior.Color = vbGreen
Worksheets("sheetName").Cells(j, 5).Interior.Color = vbGreen
Exit For
End If
End If
Next j
Next i

Color rows red when there are duplicated values in three columns

I am struggling to color rows red when there are duplicated values
I have a table like this that might have a different number of rows in xlsm file that has several sheets, so I need to look for the right worksheet. All three rows should have the same length.
orderId
OrderNumber
PositionNumber
something1
1
1
something1
1
2
something2
1
1
something2
2
1
something2
2
1
something3
3
1
something2
2
1
The rows have the same data in all three columns, so they are duplicates that should be colourd red.
orderId
OrderNumber
PositionNumber
something2
2
1
something2
2
1
something2
2
1
Now I have been trying to colour it red, but I know next to nothing about VBA and it is hard for me to figure out how to do it.
I need to also do it for two columns in other sheet, but I guess once I can do it for three I can do it for two columns as well.
I have tried to write something, but it doesn't work.
Sub lookForDuplicates()
Dim C1 As Range, Rng As Range
Dim Value As String
For Each C1 In orders.Range("A2", orders.Range("B" & orders.Range("C", Rows.Count)).End(xlUp))
Vlu = Cl.Value & "|" & Cl.Offset(, 1).Value & "|" & Cl.Offset(, 2).Value & "|" & Cl.Offset(, 3).Value
If Vlu.exists Then
row.Interior.Color = vbRed
End If
Next C1
End Sub
You don't need VBA, you can just use Conditional Formatting with a Formula.
Imagine for a moment that these 3 Columns are A, B, and C, and you want to add a new Column, D, which says True or False, depending on whether the row is a duplicate.
If Row 2 is a duplicate, then there will be more than 1 Row where Column A contains the value from Cell A2, Column B contains the value from Cell B2, and Column C contains the value from Cell C2.
To count how many rows match those criteria, we can use a COUNTIFS function in a Worksheet Formula:
=COUNTIFS($A:$A,$A2,$B:$B,$B2,$C:$C,$C2)
To convert this into True and False if more than 1 Row matches (because, this will also count Row 2 itself!), we just need to ask it ">1?"
=COUNTIFS($A:$A,$A2,$B:$B,$B2,$C:$C,$C2)>1
And that True/False result is exactly what you need for a Conditional Formatting rule under "Use a formula to determine which cells to format"!
If you want to only colour the repeats (i.e. the second and subsequent appearance of the rows, but not the first) then you want to only check the Column so far, and not the entire Column:
=COUNTIFS($A$1:$A2,$A2,$B$1:$B2,$B2,$C$1:$C2,$C2)>1
If you want to colour the first entry in a different colour when it has repeats, then you can create another Conditional Formatting entry using an AND to contrast both versions:
=AND(COUNTIFS($A:$A,$A2,$B:$B,$B2,$C:$C,$C2)>1, NOT(COUNTIFS($A$1:$A2,$A2,$B$1:$B2,$B2,$C$1:$C2,$C2)>1))
Please, try the next code. It will color in red only rows being duplicate, I mean starting from the second occurrence of the same row content. If you need deleting the duplicate rows, you can simple replace rngRed.Interior.Color = vbRed with rngRed.EntireRow.Delete:
Sub lookForDuplicates()
Dim shO As Worksheet, lastR As Long, rng As Range, arr
Dim rngRed As Range, i As Long, dict As New Scripting.Dictionary
Set shO = ActiveSheet 'use here the sheet you need
lastR = shO.Range("A" & shO.rows.count).End(xlUp).row
Set rng = shO.Range("A2:C" & lastR)
arr = rng.Value2 'place the range in an array for faster iteration
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) Then
dict.Add arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3), vbNullString
Else
addRange_ rngRed, rng.rows(i)
End If
Next i
If Not rngRed Is Nothing Then rngRed.Interior.Color = vbRed
End Sub
Sub addRange_(rngU As Range, rngAdd As Range)
If rngU Is Nothing Then
Set rngU = rngAdd
Else
Set rngU = Application.Union(rngU, rngAdd)
End If
End Sub
Coloring a row at a time is much slower, that's why previously placing them in a Union range and color all the range at once, at the end, is much faster.
If the Union range can be huge (more than 2000 areas, or even more...), the Union range building will start slowing the code. In such a case I can supply a different code able to let the code running fast, even for such cases
If necessary, the above code can be easily adapted to color the initial row, too...

Replace with 3 conditions is failing - Excel VBA

What I am trying to accomplish is:
If cells in column F contain a number, then convert it to a percentage
If cells in column F are empty and the corresponding cell in column G contain 0 then write in cell in column F "-"
If cells in column F dont contain a number and the corresponding cell in column G contain a number higher than 0 then write in cell in column F "Action Required"
Column G is formatted as number.
However, with the given code, everything becomes "-". Where is the trick?
Sub Replace()
Dim ws As Worksheet, dataLastRow As Long, cell As Range, MyRng As Range
Set ws = ThisWorkbook.Worksheets("MyTab")
Application.ScreenUpdating = False
dataLastRow = ws.Range("F" & Rows.Count).End(xlUp).Row
Set MyRng = ws.Range("F2:F" & dataLastRow)
' Loop through column F
For Each cell In MyRng
If cell = "" And cell.Offset(0, 1) = 0 Then
cell = "-"
ElseIf cell = "" And cell.Offset(0, 1) > 0 Then
cell = "Action Required"
ElseIf cell >= 0 Then
With MyRng
.NumberFormat = "0.00%"
.Value = .Value
End With
Else
End If
Next cell
Application.ScreenUpdating = True
End Sub
Your question looks weird: you get a list of data, you need to summarise those data and instead of putting the summary in another column, you decide to overwrite your data with your summary.
In case you change your mind, I've written this formula which creates the summary (not entirely correct, some small adaptations need to be done):
=IF(AND(ISBLANK(F1),G1=0),"-",IF(ISNUMBER(F1),F1,"Action required"))
(Oh, in case you use the formula, don't forget modifying the cell format into percentage.)

Range is filling up with hidden row values, not sure why

I am trying to fill a range with a filtered column of dynamic length. At this moment, after filtering, my column is 179 rows (total row count is >25000). When I print range.rows.count, it shows, correctly, that it has 179 values. but when I print each value using a for loop, it includes values that are hidden. I'm not sure why this is happening.
Here is the code I'm using:
LR = Range("O" & Rows.Count).End(xlUp).Row
Set rng = Range("O2:O" & LR).SpecialCells(xlCellTypeVisible)
Here's the code I use to view what it contains:
For x = 1 To rng.Count
Debug.Print rng.Cells(x, 1).Value
Next x
Debug.Print x
Applying the Cells (or Range) properties to a range doesn't restrict you to cells actually in that range, it merely provides an anchor point. You would be better off with a For Each loop like this:
For Each cell in rng.Cells
Debug.Print cell.Value
Next cell

Enter User Defined Function into Column Using VBA

I currently am using a formula in Column J of Sheet 2 of my workbook that will look up values from 5 columns on Sheet 1 and return the corresponding text. For example if the value from column M on Sheet 2 matches any of the values from column J on Sheet 1 it would return "N", if not it would look in column K and if matched anything there it would return D, and so on. I am doing this in VBA so the formula used is
ActiveSheet.Range("J2:J" & intLastRow).FormulaR1C1 = _
"=IFERROR(IF(ISNUMBER(MATCH(RC[3],Sheet1!C10,0)),""N"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C11,0)),""D"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C12,0)),""R"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C13,0)),""G"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C14,0)),""F"",""""))))), """")"
This formula works well and fills in the corresponding values. I then created a user defined function that will look up all of the values in column J that are associated with an ID number found in column C and separate them by commas. This function also works well when entered into a cell.
Function get_areas(ID As String) As String
Dim rng As Range, cel As Range
Set rng = Range("A2:A" & Cells(rows.count,1).End(xlUp).Row)
Dim areas As String
For Each cel In rng
If IsNumeric(Left(cel, 1)) And cel.Offset(0, 2) = ID Then
If InStr(1, areas, cel.Offset(0, 9)) = 0 Then
areas = cel.Offset(0, 9) & ", " & areas
End If
End If
Next cel
areas = Trim(Left(areas, Len(areas) - 2))
get_areas = areas
End Function
Ideally, what I would like to do is run the original formula in all cells in column J that DON'T start with Master in Column A and then run the get_areas($C2) function in all cells that DO start with master in Column A. If that is not feasible, then I would like to run the get_areas function in all cells that are blank (meaning they didn't return anything from the original formula, but still have the formula in them) in VBA. I have tried modifying the original formula to read
ActiveSheet.Range("J2:J" & intLastRow).FormulaR1C1 =
"=IFERROR(IF(LEFT(RC[-9],6)=""master"", get_areas(RC[-7]),
IF(ISNUMBER(MATCH(RC[3],Sheet1!C10,0)),""N"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C11,0)),""D"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C12,0)),""R"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C13,0)),""G"",
IF(ISNUMBER(MATCH(RC[3],Sheet1!C14,0)),""F"","""")))))), """")"
but received errors about the get_areas function.
WorksheetFunction.Trim
All of this might have nothing to do with your case but might be useful in some similar cases. It just keeps ringing in my head and you know how it is when you can't keep your mouth shut.
I would have written the function like this:
Function get_areas(ID As String) As String
Dim rng As Range
Dim i As Long
Dim areas As String
Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
With rng
For i = 1 To .Cells.Count
If IsNumeric(Left(.Cells(i, 1))) And .Cells(i, 1).Offset(0, 2) = ID Then
If InStr(1, areas, .Cells(i, 1).Offset(0, 9)) = 0 Then
If i > 1 Then
areas = areas & ", " & .Cells(i, 1).Offset(0, 9)
Else
areas = .Cells(i, 1).Offset(0, 9)
End If
End If
End If
Next
End With
get_areas = WorksheetFunction.Trim(areas)
End Function
which in all is not so important as the 'WorksheetFunction' part.
WorksheetFunction.Trim removes all spaces except single spaces between words, while VBA's Trim function only removes the left and right spaces.
The other most noticeable difference is the 'If i > 1' block.

Resources