Solved

Compare Excel cells and highlight

Posted on 2015-01-25
12
134 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:Wass_QA
  • 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:Wass_QA
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
 

Author Comment

by:Wass_QA
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 

Author Comment

by:Wass_QA
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:Wass_QA
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:Wass_QA
ID: 40569516
All good.
I got it
thanks
0
 

Author Closing Comment

by:Wass_QA
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

706 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now