I have an Excel VBA procedure which is supposed to compare the values of two cells. In my case they are scalars, ranging from 1 to 3. Basically, they are answers to questions. If they match, then I want to color a certain cell green, otherwise I want to make it red. Is there something wrong with my syntax?
Sub CheckBold()
'
' CheckBold Macro
'
'
Row = ActiveCell.Row
If ThisWorkbook.Sheets(1).Range("D" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 1
End If
If ThisWorkbook.Sheets(1).Range("E" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 2
End If
If ThisWorkbook.Sheets(1).Range("F" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 3
End If
ActiveCell.Value = ThisWorkbook.Sheets(3).Range("A" & CStr(ActiveCell.Row)).Value & ActiveCell.Value
If CInt(ActiveCell.Value) = CInt(ThisWorkbook.Sheets(3).Range("A" & CStr(ActiveCell.Row)).Value) Then
ActiveCell.Interior.Color = RGB(0, 180, 0)
Else
ActiveCell.Interior.Color = RGB(180, 0, 0)
End If
End Sub
What happens is that always the code goes on the Then branch of the if, even though the values are different. Why do I get this behavior?
Related
I'm trying to write a VBA in order to change the color (between two different ones) of a table row if the content of a cell is different from the previous.
The row n. 3 must have this color: RGB(221, 245, 253), while the other color is white.
I'm not able to figure out which would be the logic code and how to change the background color of the cells without changing the font color.
Public Sub Overview()
Dim Ovtask As String
Dim Ovn, Ovi As Integer
Ovn = Range("B2").CurrentRegion.Rows.Count
Range("B3:C3").Font.Color = RGB(221, 245, 253)
For Ovi = 3 To Ovn + 1
Ovtask = Range("B" & Ovi)
If Range("B" & Ovi + 1) = Ovtask Then
Range("B" & Ovi + 1 & ":" & "C" & Ovi + 1).Font.Color = Range("B" & Ovi & ":" & "C" & Ovi).Font.Color
Else
Range("B" & Ovi + 1 & ":" & "C" & Ovi + 1).Font.Color = RGB(0, 0, 0)
End If
Next Ovi
End Sub
In the linked image you can see what would be the desired result
As BigBen states in the comments, to set the color of a cell, you use Interior.Color. I thought about conditional formatting, but I think you are right, it's not possible in this case.
The logic you use in your code is flawed: Once it sets a row to white, it will never set any row to blue: Either the next row is equal, then you set it to white because the current row is white, or it is not equal, then you set it to white anyhow.
Have a look to the following code snippet: I declare a boolean variable UseHighlightColor that keeps track if the current row needs to be colored blue or not and sets the Interior.Color accordingly. Some remarks to the color:
- white is RGB(255, 255, 255). RGB(0, 0, 0) results in black.
- there is a predefined constant vbWhite you could use.
- To set the cells transparent instead of white, you can use ColorIndex = xlNone.
And a remark to your code: You are using Range unqualified, so VBA automatically refers to the ActiveSheet (the sheet that has currently the focus). This is not always the sheet you work with. In my example, I have written With ActiveSheet, but you can easily change this so that the code uses the sheet you want, eg ThisWorkbook.Sheets(1). Inside the With, I use the syntax .Range (with leading .), this tells VBA to use the object (sheet) defined in the With-clause. Don't rely on ActiveSheet (and don't use Activate).
With ActiveSheet
Ovn = .Range("B2").CurrentRegion.Rows.Count
Dim useHighLightColor As Boolean
useHighLightColor = True
For Ovi = 3 To Ovn + 1
Dim currentCell As Range
Set currentCell = .Range("B" & Ovi)
If useHighLightColor Then
currentCell.Resize(1, 2).Interior.Color = RGB(221, 245, 253)
Else
' curentCell.Resize(1, 2).Interior.Color = vbWhite
currentCell.Resize(1, 2).Interior.ColorIndex = xlNone
End If
If currentCell <> currentCell.Offset(1, 0) Then
' Switch color
useHighLightColor = Not useHighLightColor
End If
Next Ovi
End With
Example of the file
I have been trying to learn VBA to write a code to create a macro to help me get an output cell depending on many conditions in other cells.
So what I want is to fill each cell in column M based on other parameters in the same row of that cell depending on different level of priority:
1- if the cell in Column J is not "PASS" then I want the corresponding cell in M column to show whatever is in J other than "PASS".
2- if the cell in column J is "PASS" then the corresponding cell in column M will depend whether the cell in column I is "NO ANOMALY DETECTED" or anything else. If it's anything else then make the cell in column M whatever is in column I. Otherwise if it is "NO ANOMALY DETECTED" then make the value of the cell in column M similar to that in column G but replacing "NO ANOMALY DETECTED - " by "Euploid, " and keep XY or XX.
I also tried colouring based on value.:
The code I used:
Sub QC()
If Range("J2:J98").Value <> PASS Then Range("M2:M98").Value = Range("J2:J98")
End If
Sub Abnormality()
If Range("J2:J98").Value = PASS and Range("I2:I98").Value <> "NO ANOMALY DETECTED" Then Range("M2:M98").Value = Range("I2:I98") and cell.Interior.Color = vbRed
End If
Sub Euploid_Sex()
If Range("J2:J98").Value = PASS and Range("I2:I98").Value = "NO ANOMALY DETECTED" and Range("G2:G98").Value = "NO ANOMALY DETECTED - XY" Then Range("M2:M98").Value = "Euploid, XY"
ElseIf Range("J2:J98").Value = PASS and Range("I2:I98").Value = "NO ANOMALY DETECTED" and Range("G2:G98").Value = "NO ANOMALY DETECTED - XX" Then Range("M2:M98").Value = "Euploid, XX"
End IF
Sub Result_Coulour()
IF Range("M2:M98").Value = "Euploid, XY" then Range ("M2:M98").Font.Color - RGB(0, 176, 240)
ElseIf Range("M2:M98").Value = "Euploid, XX" then Range ("M2:M98").Font.Color - RGB(255, 153, 255)
End IF
This would really be done best in formulae in the sheet itself. Otherwise, you can't really assess each value in a range in VBA without looping through the range itself e.g.
Sub QC()
If Range("J2:J98").Value <> PASS Then Range("M2:M98").Value = Range("J2:J98")
End If
Should be something more like:
Sub QC()
For Each cel In Range("J2:J98")
If cel.Value <> "PASS" Then cel.Offset(0, 3).Value = cel.Value
Next cel
End If
I'm going through each cel in the range, and if the value is not equal to "PASS" then I'm telling it the cell 3 columns to the right (Offset(0,3)) should be the same cel.Value
You could then nest your logics e.g.
Sub QC()
For Each cel In Range("J2:J98")
If cel.Value <> "PASS" Then
If cel.Offset(0,1).Value <> "NO ANOMALY DETECTED" Then
cel.Offset(0, 3).Value = cel.Offset(0,1).Value
Else
cel.Offset(0,3).Value = cel.Value
End If
End If
Next cel
End If
However, there are some cool things you can do in VBA like filling a range with formulae to do calculations and then replacing it instantly with those calculated numbers (to avoid having formulae in the cells), so you could do something like:
Sub FillColumnM()
Range("K2:K98").Formula = "=IF(J2<>""PASS"",J2,IF(I2<>""NO ANOMALY DETECTED"",I2))"
Range("K2:K98").Value2 = Range("K2:K98").Value2
End Sub
Got this vba so far:
For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
If Len(cell.Value) = 11 Then
cell.Copy Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cell
I need to add some code behind "11" in the second line, but I can't figure out how to write it. What I want to do is to add something like "and digit number 8 (of 11) is 1 or 3 or 5 or 7 or 9 then".
Anyone that can help me out?
Try this
For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
If Len(cell.Value) = 11 Then
Select Case Mid(cell.Value, 8, 1)
Case 1, 3, 5, 7, 9
cell.Copy Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End Select
End If
Next cell
I couldn't follow your explanation but according to your title, you need to check if the 8th character is a string (from a cell, etc) is "the right one":
Function Check8thCharacter(myString As String, theRightOne As String) As Boolean
Check8thCharacter = (Mid(myString, 8, 1) = theRightOne)
End Function
Here's an example of it in use:
Sub Digit8()
Range("A1") = "ABCDEFGHIJKLM"
Const testRightOne = "H"
If Check8thCharacter(Range("A1"), testRightOne) Then
MsgBox "It's the right one!"
Else
MsgBox "It's the wrong one."
End If
End Sub
Another look at your question makes me wonder if you're actually trying to determine whether the eighth character of a cell is an odd number, which is only a slight variation:
Function Is8thOdd(rg As Range) As Boolean
On Error Resume Next 'error will also return false
Is8thOdd = (Mid(rg, 8, 1) / 2 <> Mid(rg, 8, 1) \ 2)
End Function
Here's an example of it in use:
Sub Digit8()
If Is8thOdd(Range("A1")) Then
MsgBox "Yes, it's odd"
Else
MsgBox "No, it's not odd."
End If
End Sub
I have one column of data with either "UP", "DOWN" or "" as values. I am trying to write code that states that for all rows, if the first cell is "UP" then check the next rows until I come to either "DOWN" or "UP", i.e. if the next row has a "" then check the next row until I come to either a "DOWN" or "UP".
I am very new to VBA, and have tried various options, but seem to only be able to bring back where there are consecutive "UP"s or "DOWNS" rather than where there is an "UP", a number of rows of "" and then another "UP".
This is my code:
Range("z1:z250").Select
Selection.ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
For sRow = 3 To 250
If Range("Y" & Row + 1).Value = "UP" Then
Range("Z" & Row) = "MT-UP"
ElseIf Range("Y" & Row + 1).Value = "" Then
End If
Next
End If
Next
End Sub
I have tried to add code such as For Each c in Range (“Y3”:”Y250”) but this doesn't make it find the next UP, and makes it very slow. I have also tried GoTo next cell (although seem to understand this is frowned upon!) but this doesn't work either. Any help appreciated.
Not 100% clear if this is what you want but take a look...
Instead of nested loops I used a flag to mark when a second consecutive "UP" was found before encountering a "DOWN". From your description it seems there's no need to check for empty cells ("").
Sub MTTest()
Dim Row As Long
Dim MTRow As Long
Dim MTFlag As Boolean
Range("Z1:Z250").ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
If MTFlag = True Then
Range("Z" & MTRow) = "MT-UP"
MTFlag = Flase
Else
MTFlag = True
MTRow = Row
End If
Else
If Range("Y" & Row).Value = "DOWN" Then MTFlag = False
End If
Next
End Sub
I am trying to write a VBA Script to format a list of several thousdand phone numbers I have stored in an excel spread sheet. So far I have this, but when I run it it doesn't format the phone number. It does add the value NULL if the cell is empty but doesnt format the number anyone see what I am doing wrong?
Sub CheckPhoneNumber()
Dim retNumber As String
Range("K3").Activate
Do Until ActiveCell.Row = 3746
If ActiveCell.Value = "" Then
ActiveCell.Value = "NULL"
Else
For i = 1 To Len(ActiveCell.Value)
If Asc(Mid(ActiveCell.Value, i, 1)) >= Asc("0") And Asc(Mid(ActiveCell.Value, i, 1)) <= Asc("9") Then
retNumber = retNumber + Mid(ActiveCell.Value, i, 1)
End If
Next
If Len(retNumber) > 10 Then
cleanPhoneNumber = Format(retNumber, "(+#) 000-000-0000")
Else
cleanPhoneNumber = Format(retNumber, "000-000-0000")
End If
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Looks like you forgot to write cleanPhoneNumber back to the sheet? you need an ActiveCell.Value = cleanPhoneNumber before the final end if.