vba , higlight cells if it contains anything from criteria

[Mallesh23]

Hi Team,

Below code works for exact cells match for list of Array value,
Now I am looking for Contains, instead of exact match.

Example-
if Array value Contain Red, and Cell value Contain Redish,
then Still it has bold that cell. Because Red is Contained in cell value....



Sub test()
Dim ar As Variant
ar = WorksheetFunction.Transpose(Sheet1.Range("G2:g5").Value) 'array("Green",Red","Yellow"
or
' ar = Sheet1.Range("G2:g5").Value)

Dim lr As Long
Dim i As Long

lr = Sheet1.Range("a1000").End(xlUp).Row
For i = 2 To lr 'List of Color
If IsNumeric(Application.Match(Sheet1.Cells(i, 1).Value, ar, 0)) Then
Sheet1.Cells(i, 1).Font.Bold = True
End If
Next i

End Sub


Regards,
mg

 

[Mallesh23]

Hi Danteamor and Peter,

Thank you once again for help in simplifying it further

I tested the code your array code, I am getting desired result. however need one small correction.
In my input file , Column D comes with values, below lines replace original value and updates with c(i, 1) = "Found"

wbk.Sheets(1).Range("D2").Resize(UBound(b), 1).Value = c()

also explain plz explain below line.
a = r.SpecialCells(xlCellTypeConstants).Value



Regards,
mg

 

[DanteAmor]

You want to keep your original values, the simplest is to put the results in another column, for example, A column you don't use, let's say the Z::
wbk.Sheets(1).Range("Z2").Resize(UBound(b), 1).Value = c()

The next line means that it will only take data from cells that are not empty. The values are taken from the cell range of the r object. Object r has the range G2: G50
a = r.SpecialCells(xlCellTypeConstants).Value

Set r = ThisWorkbook.Sheets(1).Range("G2:G50")

"
Continuing with the option to use the wild card, it shows you another option, with a little more code, but it should be faster than my post #12 macro.
Just consider that there should be no intermediate blank cells in your G2:G50 range.
"

 

[Peter_SSs]

In my input file , Column D comes with values, below lines replace original value ...

Are you saying that no original values in column D should be overwritten?

Or should some selectively be overwritten? If so, how do we decide which ones should be overwritten and which ones should not?

Are the 'original values' in column D formula cells or just 'constant' values?

 

[Mallesh23]

Hi Peter,
There will be values in column D not a formula, I want value to be overwritten, overwriting Criteria will be depend column A cells.
like as shown below, c.value comes from Unique value list.
If wbk.Sheets(1).Range("A" & i).Value Like "*" & c.Value & "*" Then
wbk.Sheets(1).Range("D" & i).Value = "Found"

Regards,
mg

 

[Peter_SSs]

I want value to be overwritten,

If that is all values then my previous code will do that. If it is not all values then please answer my question about that:

.. how do we decide which ones should be overwritten and which ones should not?

Also, if you are asking about my code/approach, there isn't much point quoting code from Dante's solution.

 

[DanteAmor]

Hi @Mallesh23, You quoted my code, I guess you are using my code. My code overwrites the entire column D.
You could confirm: do you want to overwrite all values or do you want to keep some (which ones?)

Did you check the alternative in my post #22?

 

[Mallesh23]

Hi Sir,
I used your post 12 to my situation just modified little as per my requirement and its working.
do you want to overwrite all values :- No I don't want to overwrite complete column , only cells which I found in unique list,
I am offsetting and updating in D columns cell.

I checked your array code it is replacing original value as well. so I used post 12
is it possible update column D without taking any helper column z.

Regards,
mg

 

[DanteAmor]

I am not understanding well, my code in post #12 updates only the cells that match.

The only detail is that it is case sensitive.
But if you don't want the macro to be case sensitive, then you can use the following updated macro.

Sub PartialMatch_v3()
  Dim wbk As Workbook
  Dim r As Range, lr As Long, i As Long, c As Range
 
  Set wbk = Workbooks.Open("C:\Users\User\Desktop\New folder\input_File.xlsx")
  lr = wbk.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
 
  Set r = ThisWorkbook.Sheets(1).Range("G2:G50")
  '
  For i = 2 To lr
    For Each c In r
      If c.Value <> "" Then
        If LCase(wbk.Sheets(1).Range("A" & i).Value) Like "*" & LCase(c.Value) & "*" Then
          wbk.Sheets(1).Range("D" & i).Value = "Found"
        End If
      End If
    Next
  Next i
End Sub