I have this code:
Sub Japan()
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If Cell.Value = "A" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "B" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "C" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "D" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "E" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
End Sub
THis find any cells that have either A, B, C, D, E as the value and then colours the entire row red if so.
Basically, I have hundreds of more values that I want to lookup. I have them stored in another excel file (could just as easily be in a text file). How could I reference them? ie, if cell value is in this list of text, do this.
Sounds like you want a Set datastructure that contains unique values and you can use an Exist
method on it.
For example your desired usage is this.
Set MySet = LoadRedValueSet(???) ' explain later
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If MySet.Exists(Cell.Value) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
Well too bad Set
is a reserved keyword and VBA does not provide a Set object. However, it does provide a Dictionary
object which can be abused like a Set would be. You will need to reference the Scripting Runtime Library to use it first through . The usage would be exactly as stated as above. But first we need to define LoadRedValueSet()
Lets assume that you are able to load whatever file you save these values as in as an Excel worksheet. I will not be explaining how to open various file types in Excel as there are many answers detailing that in more detail than I can. But once you have your range of values to add to the set we can add them to the dictionary.
Private Function LoadRedValueSet(valueRange As Range) As Dictionary
Dim result As New Dictionary
Dim cell As Range
For Each cell In valueRange.Cells
result(cell.value) = Nothing
Next cell
Set LoadRedValueSet = result
End Function
Dictionary are mapping objects that have key->value pairs. The key's are effectively a set, which is what we want. We don't care about the values and you can pass whatever you want to it. I used Nothing
. If you use the .Add
method the dictionary will throw an error if your list contains duplicate entries.
Assuming you have implemented some function that loads your file as a worksheet and returns that worksheet.
Dim valueSheet As Worksheet
Set valueSheet = LoadSomeFileTypeAsWorksheet("some file path")
Dim valueRange As Range
Set valueRange = valueSheet.??? 'column A or whatever
Dim MyDictAsSet As Dictionary
Set MyDictAsSet = LoadRedValueSet(valueRange)
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If MyDictAsSet.Exists(Cell.Value) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
There are quite a few ways you could possibly do this but here's my approach. Application.WorksheetFunction.<function name>
can be used to evaluate worksheet functions within VBA. This means we can use it to run a Match function. For the sake of a simple example let's assume your values to match are in Column A of a worksheet called Sheet2 (in the same workbook).
Dim MyPlage As Range, Cell As Range
Dim result as Variant
Set MyPlage = Range("A1:R1000") '<~~ NOTE: Sheets("<SheetName>").Range("A1:R1000") would be better
For Each Cell in MyPlage
result = Application.WorksheetFunction.Match(Cell.Value, Sheets("Sheet2").Range("A:A"), 0)
If Not IsError(result) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next Cell
We only need to know whether or not the WorksheetFunction.Match
function returned an error: If it didn't then Cell.Value was present in Column A of Sheet2 and we color the row red.
Paste your color value + index data to a new sheet called "Colors" in the following order;
Value ColorIndex
A 1
B 2
C 3
D 4
E 5
And update your method with the following code and update the range based your data;
Sub SetColors()
' DataCells: The cells that's going to be checked against the color values
Set DataCells = Range("A1:A15") ' Update this value according to your data cell range
' ColorValueCells: The cells that contain the values to be colored
Set ColorValueCells = Sheets("Colors").Range("A2:A6") ' Update this value according to your color value + index range
' Loop through data cells
For Each DataCell In DataCells
' Loop through color value cells
For Each ColorValueCell In ColorValueCells
' Search for a match
If DataCell.Value = ColorValueCell.Value Then
' If there is a match, find the color index
Set ColorIndexCell = Sheets("Colors").Range("B" & ColorValueCell.Row)
' Set data cell's background color with the color index
DataCell.Interior.ColorIndex = ColorIndexCell.Value
End If
Next
Next
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.