Automatically copy a cells colour to another cell - excel

This is a very simple problem that I can't seem to find the solution. Basically I use 3 different cell styles (good,neutral and bad). What I simply want to do is I want the cell adjacent to the one I colour coded to be the same colour. For example cell O11 I selected it to be good (green colour), hence cell M11 should automatically change its cell style according to cell O11.
Any suggestions?
P.S O11 will be set manually (no conditional formatting)

To solve your problem you need to create a variable to hold the cells color value and set that value back to another cell. Use the following example:`To solve your problem you need to create a variable to hold the cells color value and set that value back to another cell. Use the following example:
To solve your problem you need to create a variable to hold the cells color value and set that value back to another cell. Use the following example:
Sub Copy_Color()
Dim iColor As Long
iColor = ActiveCell.Interior.Color
ActiveCell.Offset(0, 1).Interior.Color = iColor
End Sub

To solve your problem you need to create a variable to hold the cells color value and set that value back to another cell. Use the following example:
Sub Copy_Color()
Dim iColor As Long
Dim i as long
for i = 11 to 20
iColor = worksheets("Sheet name").range("M" & i).Interior.Color
worksheets("Sheet name").range("O" & i).Interior.Color = iColor
next
End Sub

Related

How to replace styles of an Excel sheet cell with no style and then add value to cell?

I have inherited an Excel sheet (from a previous employee) that uses background color to convey information, rather than placing values in the cells.
Update: I should have mentioned that, although the document is an Excel sheet, our office is using LibreOffice for our suite. I think that LibreOffice uses StarBasic rather than VBscript.
Currently, this Excel sheet is looked at by human eyes only, but soon this sheet will be fed into a larger system. It will make more sense for this particular column in the sheet to have actual data rather than just styles.
How can I search/replace all cells in a column of data based on styling of the cell, AND add a value in the place of the background color.
if the cell has a background color (in this case: black), replace that with no background color.
then, add some value into the cell (for this sheet, a simple TRUE or FALSE should probably be good enough)
Very rough pseudo-code for what I hope to be able to do:
for each ( cell in column-X of sheet(1) ) {
if cell.background.color == BLACK {
cell.background.color = NO_BACKGROUND_COLOR
cell.value = "false"
}
}
Assuming that the cell changes required affect only the color and contents of the cells.
The changes can be done all in one run, provided a little bit of planning is done before, with a table like this information:
| Actual | Color | Change |
To explain graphically how to obtain the colors to be replace, lets assume the picture below represents the table that we need to apply the changes to:
To determine the color of the cell we’ll use the Immediate Window.
In the VBA editor, press Ctrl+G to open the Immediate Window.
Select in Excel one cell with a color to replace.
Type ?activecell.interior.color in the Immediate Window to obtain the color of the cell.
Repeat for each color.
This the Table completed.
We’ll use the Select Case statement to apply the table with the action for each color
Sub Cell_Color_Replace()
Dim rTrg As Range
With ThisWorkbook.Sheets("DATA")
Rem To set all used cells in the worksheet as the target range
Set rTrg = .UsedRange
Rem A method to set the range
Set rTrg = .UsedRange.Columns(11)
Rem Another method to set the range
Set rTrg = .Range("K7:K30")
End With
Call Cell_Color_Replace_APPLY(rTrg)
End Sub
…
I broke the method in two procedures so the key procedure below can be called from any other procedure.
Sub Cell_Color_Replace_APPLY(rTrg As Range)
Dim rCll As Range
Dim vValue As Variant 'variant to allow different datatypes
For Each rCll In rTrg.Cells
With rCll
Select Case .Interior.Color
Case 13561798: vValue = True
Case 13551615: vValue = "BAD"
Case 10284031: vValue = 1234
Case Else: vValue = "¡NOACTION"
End Select
If vValue <> "¡NOACTION" Then
.Interior.Pattern = xlNone
.Value = vValue
End If
End With: Next
End Sub
And this is the range adjusted, note that I used styles that include font.color format, so the performance of the method is visible.
Your 'Pseudo-code' is definitely along the right lines.
I had to do something similar myself once - Try the below, it's quite crude but should do the trick;
Sub ChangeBackground()
Dim MacroRange as Range
Set MacroRange = Activesheet.Range("A:A") 'replace this with whatever range you want the macro to affect,
' I originally just used ActiveSheet.Usedrange to do the whole sheet
Dim rngCell As Range
Dim Colour As Long
Colour = Selection.Interior.Color
Debug.Print Colour
For Each rngCell In ActiveSheet.MacroRange
If rngCell.Interior.Color = Colour Then
rngCell.Interior.ColorIndex = 0 'no fill
rngCell.value = "Value" 'insert desired value here
End If
Next
End Sub
NB This uses Activesheet and Selection a lot !! (Bad form I know, but I had to do exactly the same once and it was just the quickest way of doing it at the time). Before starting this macro, you'll need to have the desired workbook and sheet activated, and a cell with the colour to be replaced selected.
In my case I had multiple colours to replace but just did them one at a time (they needed different values), hence the Selection element to pick the colour.

VBA for filtering cells in a row based on another cell value in the same row

I have an excel sheet with numbers in each cell. I want to eliminate the cells containing values which are larger than a specific value, different for each row, for example in the picture
I want to eliminate all the cells in a certain row that has values more than the BL cell.
Not sure the exact context in which this is being used, So possibly some conditional formatting would be more stable?
Also not sure what you meant by "Eliminate" so the following code just turns the cell red.
anyway, hopefully this code will help you get started :)
Sub Cell_Vaue_Check()
Dim row As Excel.Range
Dim cel As Excel.Range
For Each row In Sheets("Sheet1").Range("A1:C5").Rows '<<- Replace "Sheets("Sheet1").Range("A1:C5")" with the Sheet and Range you want to check
For Each cel In row.Cells
If cel.Value > Range("E" & cel.row).Value Then '<<- Replace "E" with the Column in which the check value is located
cel.Interior.Color = RGB(288, 0, 0) '<<- This line turns the cell Red. Replace it with whatever code you want depending on what "eliminate" means to you
End If
Next
Next
Set row = Nothing
Set cel = Nothing
End Sub
If Anybody has any improvements please feel free to Add!

Using For Each Loop to Copy Conditional Formatting Color

I am trying to apply the conditional formatting color of one cell to another cell. I am doing this in order to create a heat map. However, the values in the heatmap are not the values that fit the criteria of the conditional formatting (which is why I am copying the color from the cells that actually fit the criteria). I know I can do this process using a loop, but I am struggling in actually doing so.
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
cnt = 2
For Each cell In Range("J78:L81")
Me.cell.Interior.Color = Me.Range("H" & cnt).DisplayFormat.Interior.Color
cnt = cnt + 2
Next cell
End Sub
The editor gives me a Compile Error saying "Method or data member not found" and it points towards the .cell in Me.cell.Interior.Color
The Me statement needs to be infront of the Range("J78:L81") instead of Cell.
For Each cell In Me.Range("J78:L81")
cell.Interior.Color = Me.Range("H" & cnt).DisplayFormat.Interior.Color

Excel vba conditional formatting using dynamic color key

I'm trying to create an Excel macro that applies conditional formatting to a target column using the condition of cells in another column and the format of cells in yet another column (essentially a color key).
The color key is a single column chart with colored cells containing text in each row (e.g. blue cell with "blue" as the text).
The goal is to be able to change the fill colors or text in the color key and have the target cells automatically change to the new colors or condition without having to hardcode the new RGB through Excel's conditional formatting rules manager.
This would save a lot of time as there are a lot of colors, and they must be the exact RGB match.
Here's what I have so far:
Sub ColorCode()
'Applies conditional formatting to Input Chart using the Color Key
Application.ScreenUpdating = False
Dim ColorKey As Range
Set ColorKey = Worksheets(2).Range("C6:C19")
Dim kCell As Object
Dim lCell As Object
Dim mCell As Object
With Worksheets(2)
For Each mCell In Worksheets(2).Range("Input[Duration1]")
If mCell.Value <> "0" Then
For Each lCell In Worksheets(2).Range("Input[Color1]")
If lCell.Value <> "" Then
For Each kCell In ColorKey.Cells
If lCell.Value = kCell.Value Then
mCell.Interior.Color = kCell.Interior.Color
mCell.Font.Color = kCell.Font.Color
End If
Next
End If
Next
End If
Next
End With
This loops through each of the cells in the columns and actually colors them in. The issue is all of the cells are colored to the condition of the last cell, so all of the colors are the same rather than each cell being formatted for its own condition.
Before adding "application.screenupdating=false", I can see the colors flickering while it's looping, but they just won't stick. When I try to add "ByVal Target as Range" to my code, my macro disappears, and to be honest, even though I've looked this up I don't really understand what this means.
I'm new to VBA, and am pretty sure I'm missing something simple. I'd really appreciate any help with this!
I'm marking this as answered - Here is the updated code!
Sub getcol()
Dim rr As Range
Dim tg As Range
Set color_dict = CreateObject("Scripting.Dictionary"
For Each rr In Range("colorkey")
color_dict.Add rr.Text, rr.Interior.Color
Next
For Each rr In Range("input[color1]")
rr.Offset(0, -2).Interior.Color = color_dict(rr.Text)
Next
End Sub
Not quite understanding the rule to decide what color the target cell should be from your description.
But in any case, you probably want to create a dictionary to store colors against a text key. And then use this dictionary to loop over your target range and set the color of the cell by reading the text in that target cell (??)
in the below, I assume the text to create the dictionary key is in the column next to range color_key. If the text you wish to read in to create the dictionary key is actually in the same column then remove the offset (or set it to 0 column offsets).
I assume that color_key and target_Range are named ranges in your excel sheets (somewhere).
Sub getcol()
Dim rr As Range
Set color_dict = CreateObject("Scripting.Dictionary")
For Each rr In Range("color_key")
color_dict.Add rr.Offset(0, 1).Text, rr.Interior.Color
Next
For Each rr In Range("target_Range")
rr.Interior.Color = color_dict(rr.Text)
Next
End Sub
The code CELL.Interior.Color returns an integer code that represents the cell fill color, as you mentioned you need the exact same color.
A dictionary dict works by reading in (key, value) pairs using the syntax dict.Add key, value. And returns value when it is passed the corresponding key: dict(key)=value.

Use current cell value to calculate and replace in cell

I'm very new to VBA in excel and I've tried searching for my question already.
I'm trying to calculate an answer based off the value of the cell and have the calculated value replace the current value upon macro execution. For example if A2 has an initial value of 30 I'd like too replace A2 with =A2*3 so that A2 would read 90 as its new value.
Is there any way to do this without having to copy and paste everything somewhere else first?
Thanks for any help.
Try something like this. First, make sure you have selected at least one cell, and then run the macro from the macros menu:
Sub MultiplyBy30()
Dim rng as Range
Dim cl as Range
Set rng = Range(Selection.Address)
For each cl in rng.Cells
If IsNumeric(cl.Value) And Len(cl.Value) > 0 Then
cl.Formula = "=" & cl.Value & "*30"
End If
Next
End Sub

Resources