Is there any way I can add a pattern onto a colored cell through VBA such that the color of the cell remains visible?
I am trying to do a sort of Gantt chart, where the different colours represent different people, and and want the active cell to get a pattern above to get a better view of where you are with the cursor:
In below I move the cursor one cell up. The corresponding row gets a pattern, but the red colour disappears. If I move the cursor one cell up and to the left, the same happens with the yellow colour.
I've tried VBA code below:
LR = Cells(Rows.Count, 1).End(xlUp).Row
Set PatternRng = Range("A6" & ":" & "GM" & Sheets("Source").Range("I1").Value)
PatternRng.Interior.Pattern = xlPatternNone
If ((ActiveCell.Row >= 7) And (ActiveCell.column <= 194) And (ActiveCell.Row <= LR)) Then
If (ActiveCell.column > 1) Then
Set PatternRng = Range("A6:A" & LR).Offset(, ActiveCell.column - 1)
PatternRng.Interior.Pattern = xlPatternGray25
PatternRng.Interior.PatternColor = RGB(191, 191, 191)
End If
Set PatternRng = Range("A6:GM6").Offset(ActiveCell.Row - 6, 0)
PatternRng.Interior.Pattern = xlPatternGray25
PatternRng.Interior.PatternColor = RGB(191, 191, 191)
Sheets("Source").Range("I2").Value = (ActiveCell.column - 1)
Sheets("Source").Range("I3").Value = (ActiveCell.Row - 6)
End If
Sheets("Source").Range("I1").Value = LR
I've also tried conditional formatting through VBA but I get the same result. But as the picture below shows it is possible if you do it manuelly on a cell.
Thanks in advance!
In testing, this line cleared any interior color.
PatternRng.Interior.Pattern = xlPatternNone
Instead, try
PatternRng.Interior.Pattern = xlSolid ' Solid color
or maybe:
PatternRng.Interior.Pattern = xlPatternAutomatic ' Excel controls the pattern
Related
I have a code that i copied from another forum that runs through a range of cells and copies the characters in the cells that contain parenthesis to an adjacent cell. What i would like to do is simply change the font color of the characters inside the parenthesis along with the parenthesis. I have managed to tweak the code so that i include the parenthesis but i dont know how to change the font color. I believe it requires one line of code maybe two if im not mistaken. Here is the code:
Dim n, i As Long
With CreateObject("vbscript.regexp")
.Pattern = "(\(\w+\))"
.Global = True
For i = 1 To 10
Set myMatches = .Execute(Cells(i, 1))
For Each n In myMatches
Cells(i, 2).Value = Mid(n, 1, Len(n) - 0)
Next n
Next i
End With
As you can see the 'Cells(i, 2).Value = Mid(n, 1, Len(n) - 0)' is what needs to be changed.
Thank you.
' The code below will change chars 1 to 4 in the cell red
.Cells.Characters(1, 4).Font.Color = vbRed
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
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?
I am trying to go through each point in an xy chart with multiple series and change the color based on a specific if condition (if there is a value in a specific cell).
This is driving me nuts because it is very inconsistent (sometimes just removes borders and fill remains, sometimes just removes fill and borders remain).
Extract is below.
I have tried with:
'MarkerBackgroundColor = rgb(255,255,255)
'MarkerForegroundColor = rgb(255,255,255)
Also tried making it true then back to false (seems to work for the .line...)
FYI - the If condition works, I have tested with msgbox and it is triggering at the correct times (in case you care - it is reading for blank cell values starting row 3 and jumps 4 columns every iteration of i, starting from column 7).
Code is below:
Dim ws as Worksheet
Dim cht as Chart
set ws = Worksheets("Sheet 1")
Set cht = ws.ChartObjects("Chart_Name")
For i = 2 To 8
For x = 1 To cht.SeriesCollection(i).Points.Count
If ws.Cells(x + 2, i + 5 + (3 * (i - 2))).Value = "" Or ws.Cells(x + 2, i + 5 + (3 * (i - 2))).Value = " " Then
With cht.SeriesCollection(i).Points(x)
.Format.Fill.ForeColor = rgb(255, 255, 255)
.Format.Line.Visible = msoFalse
End With
Else
End If
Next x
Next i
Ok I "fixed" it - cht.SeriesCollection(i).Points(x).MarkerStyle = -4142 (i.e. marker type = none) did it.
Still not sure why this happened - seems Format.Fill is not very reliable.
If someone has an explanation, would still be much appreciated.
So I am working on a reporting tool in Access. It queries the local tables and creates a Excel document (through VBA) and makes an Excel file.
I use the following code to color alternative code and it works beautifully
For a = 1 To rs.RecordCount
With ExcelSheet
.Cells(a + 1, 1) = a
.Cells(a + 1, 1).EntireRow.Interior.ColorIndex = IIf((a + 1) Mod 2 = 0, 2, 15)
End With
Next
Note I have to do a + 1 because a = 1 is the title row, and that is the title row.
Note: .Cells(a + 1, 1) = 1 numbers the rows (1 , 2, 3, ...)
Note : IIf((a + 1) Mod 2 = 0, 2, 15) The 2 and 15 are color codes.
Now my question is that when someone gets the Excel report they might delete a row, or do a sort operation or whatever and when they do that, it messes up the rows.
ex:
1 white row
2 grey row
3 white row
4 grey row
if i sort them I get
3 white row
1 white row
2 grey row
4 grey row
which is not what I want, I want it to keep the formatting and the numbering
Anyone to accomplish this using VBA in Access?
Tech: Office 2007
This can be accomplished with the ROW() function and some conditional formatting. The ROW() function returns the current row of the cell it is in, so it will change whenever cells are deleted, moved or sorted. Conditional formatting is re-applied whenever its conditions change, so moving or sorting rows would inform Excel to update the colors accordingly. The code would look as follows:
Dim a As Integer
Dim oneRow As Range
For a = 1 To rs.RecordCount
With ExcelSheet
''// show the row number in the first cell
.Cells(a + 1, 1).Formula = "=ROW()"
''// set formatting to alternate row colors
Set oneRow = .Cells(a + 1, 1).EntireRow
oneRow.FormatConditions.Delete
oneRow.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(ROW()-1, 2)=0"
oneRow.FormatConditions(1).Interior.ColorIndex = 2
oneRow.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(ROW()-1,2)=1"
oneRow.FormatConditions(2).Interior.ColorIndex = 15
End With
Next a
#e.James
Dim rowRange As Range
ExcelSheet.Cells(1, 1).EntireColumn.ColumnWidth = 4
ExcelSheet.Cells(1, 1) = "#"
Set rowRange = Range("2:2", rs.RecordCount & ":" & rs.RecordCount)
rowRange.Select
With ExcelApp.Selection
.FormatConditions.Delete
.FormatConditions.Add xlExpression, Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 15
End With
That dosnt work. It just highlights the very top row (the title row) grey.
EDIT NEVERMIND
Its supposed to be
Set rowRange = ExcelSheet.Range("2:2", rs.RecordCount & ":" & rs.RecordCount)
EDIT NUMBER 2:
Do you know how I can insert the row numbers in each row using this method?
ANSWER:
ExcelSheet.Cells(1, 1).EntireColumn.ColumnWidth = 4
Set RowRange = Range("2:2", rs.RecordCount & ":" & rs.RecordCount)
RowRange.Columns(1).Formula = "=ROW()-1"
With RowRange
.FormatConditions.Delete
.FormatConditions.Add xlExpression, Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 15
End With