Solved

Compare Excel cells and highlight

Posted on 2015-01-25
12
142 Views
Last Modified: 2015-01-26
Hello,
Can you please help.
I need a macro code to compare cells (Column D) and highlight the lowest cell values (Columns F,G,H).
Please see sample attached.

Example:
B3k ---- Highlight   F3,  G25,  H25
K1C ---- Highlight   F54,  G31,  H4

Any help is appreciated.
Thanks,
Sample.xlsx
0
Comment
Question by:W.E.B
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 4
  • 2
12 Comments
 
LVL 12

Expert Comment

by:FarWest
ID: 40569321
maybe you don't need VBA to do so
check condition formating-->color scales option
0
 

Author Comment

by:W.E.B
ID: 40569327
Hello,
The number of Rows varies. (Between couple hundred and few thousands).
I need to inject the VBA to another VBA used on the sheet.

thanks,
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40569359
aha, I got it,
for performance issue and easy code it s better making temporary sort on Delivery in the sheet (this requires adding line number to revert to original sort after complete,
is there any limitation to do so?
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:W.E.B
ID: 40569375
Hello,
safe to say 1500 is the Max Rows.
thanks
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40569469
check this code
Public Sub FindMin()
Dim ii As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
Dim DataRange As Range
Set DataRange = ws.UsedRange
For ii = 1 To DataRange.Rows.Count
ws.Cells(ii, 1) = ii
Next
      DataRange.Sort Key1:=ws.Range("D1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

Dim cDelivery As String
cDelivery = "NULL"
Dim cx1r As Range, cx2r, cx3r
DataRange.Range("F:H").Interior.Color = vbWhite
For ii = 1 To DataRange.Rows.Count
If ws.Range("F" + Trim(CStr(ii))).Value <> "x1" Then
If cDelivery <> UCase(ws.Range("D" + Trim(CStr(ii))).Value) Then
If cDelivery <> "NULL" Then
cx1r.Interior.Color = vbYellow
cx2r.Interior.Color = vbYellow
cx3r.Interior.Color = vbYellow
End If
cDelivery = UCase(ws.Range("D" + Trim(CStr(ii))).Value)
Set cx1r = ws.Range("F" + Trim(CStr(ii)))
Set cx2r = ws.Range("G" + Trim(CStr(ii)))
Set cx3r = ws.Range("H" + Trim(CStr(ii)))
End If
If cx1r.Value > ws.Range("F" + Trim(CStr(ii))).Value Then Set cx1r = ws.Range("F" + Trim(CStr(ii)))
If cx2r.Value > ws.Range("G" + Trim(CStr(ii))).Value Then Set cx2r = ws.Range("G" + Trim(CStr(ii)))
If cx3r.Value > ws.Range("H" + Trim(CStr(ii))).Value Then Set cx3r = ws.Range("H" + Trim(CStr(ii)))
'ws.Cells(ii, 1) = ii
End If
Next
      DataRange.Sort Key1:=ws.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal


End Sub

Open in new window

0
 
LVL 5

Expert Comment

by:Hakan Yılmaz
ID: 40569470
please try this.
select the cells you want to be checked&painted (say F2:H56), then run code.
(It will ignore texts and empty cells in the range you select.)

It will compare values within groups in column d.

Sub hakan()
    Dim myrange As Range
    Dim mysheet As Worksheet
    Dim fixcolumn As Range
    Dim itercolumn As Range
    Dim itercell As Range

    Set myrange = Selection
    Set mysheet = myrange.Worksheet
    Set fixcolumn = mysheet.Columns(4)
    
    With myrange.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    For Each itercell In myrange.Cells
        If (Not IsEmpty(itercell.Value2)) And IsNumeric(itercell.Value2) Then
            Set itercolumn = itercell.EntireColumn
            If Application.WorksheetFunction.CountIfs(fixcolumn, fixcolumn.Rows(itercell.Row), itercolumn, "<" & Val(itercell.Value2)) = 0 Then
                itercell.Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next itercell
End Sub

Open in new window

0
 

Author Comment

by:W.E.B
ID: 40569489
Hi Farwest,
thank you,
The code is replacing my data in column A with the sorting numbers.

can you please use a different Column? say Column "K"?

Hakan,
your code is not doing anything.

Thanks,
0
 
LVL 12

Accepted Solution

by:
FarWest earned 500 total points
ID: 40569499
done
Public Sub FindMin()
Dim ii As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
Dim DataRange As Range
Set DataRange = ws.UsedRange
For ii = 1 To DataRange.Rows.Count
ws.Cells(ii, 11) = ii '11 means K in column name
Next
'here we change sort
      DataRange.Sort Key1:=ws.Range("D1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

Dim cDelivery As String
cDelivery = "NULL"
Dim cx1r As Range, cx2r, cx3r
DataRange.Range("F:H").Interior.Color = vbWhite
For ii = 1 To DataRange.Rows.Count
If ws.Range("F" + Trim(CStr(ii))).Value <> "x1" Then
If cDelivery <> UCase(ws.Range("D" + Trim(CStr(ii))).Value) Then
If cDelivery <> "NULL" Then
cx1r.Interior.Color = vbYellow
cx2r.Interior.Color = vbYellow
cx3r.Interior.Color = vbYellow
End If
cDelivery = UCase(ws.Range("D" + Trim(CStr(ii))).Value)
Set cx1r = ws.Range("F" + Trim(CStr(ii)))
Set cx2r = ws.Range("G" + Trim(CStr(ii)))
Set cx3r = ws.Range("H" + Trim(CStr(ii)))
End If
If cx1r.Value > ws.Range("F" + Trim(CStr(ii))).Value Then Set cx1r = ws.Range("F" + Trim(CStr(ii)))
If cx2r.Value > ws.Range("G" + Trim(CStr(ii))).Value Then Set cx2r = ws.Range("G" + Trim(CStr(ii)))
If cx3r.Value > ws.Range("H" + Trim(CStr(ii))).Value Then Set cx3r = ws.Range("H" + Trim(CStr(ii)))
'ws.Cells(ii, 1) = ii
End If
Next
'here we revert sort
      DataRange.Sort Key1:=ws.Range("K1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal


End Sub

Open in new window

0
 

Author Comment

by:W.E.B
ID: 40569515
Hi Farwest,
I thank you very much for your help,
I made a mistake,
I have some data under Column "k"

I tried to change to Column "T" ----- ws.Cells(ii, 20) = ii '11 means K in column name
But it doesn't sort properly.

can you please help ,
sorry about this.
thanks
0
 

Author Comment

by:W.E.B
ID: 40569516
All good.
I got it
thanks
0
 

Author Closing Comment

by:W.E.B
ID: 40569517
Thank you very Much.
0
 
LVL 5

Expert Comment

by:Hakan Yılmaz
ID: 40570239
I revised code to replace decimal separator from "," to "." to use in vba.
Please try this too.
It will work even if you increase number of columns to mark minimums.
Sub hakan()
    Dim myrange As Range
    Dim mysheet As Worksheet
    Dim fixcolumn As Range
    Dim itercolumn As Range
    Dim itercell As Range

    Set myrange = Selection
    Set mysheet = myrange.Worksheet
    Set fixcolumn = mysheet.Columns(4)
    
    With myrange.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    For Each itercell In myrange.Cells
        If (Not IsEmpty(itercell.Value2)) And IsNumeric(itercell.Value2) Then
            Set itercolumn = itercell.EntireColumn
            If Application.WorksheetFunction.CountIfs(fixcolumn, fixcolumn.Rows(itercell.Row), itercolumn, "<" & Replace(itercell.Value2, ",", ".")) = 0 Then
                itercell.Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next itercell
End Sub

Open in new window

0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question