PDA

View Full Version : [SOLVED] I need help fixing macros to high light the correct data. please need help with this!



estatefinds
08-23-2016, 02:33 PM
I am attaching a file in which I have a macro that highlights data in red based on the data found in column A.

Now I have data in Columns AQ with data that I would like highlighted a specific color, and when I run it, it doesnt highlight the correct numbers in the column AQ in the Range K2:R71. the macro is module 9.

the same problem with module 10 for column AT and 11 for column AW and 12 for column AZ and 13 for column BC



the macro Module 3 works great.
but the macros Modules 9,10,11,12,13 dont highlight the correct data im looking to highlight.

for example the data in column BC when I run the macro Module 13 doesnt high light the numbers below in the Range K2:R71; it high lights other numbers in that range. just need help correcting this please!

5678


5679


5670


5689


5680


5690


5789


5780


5790


5890


6789


6780


6790


6890


7890



Thank you in advance.

mikerickson
08-23-2016, 05:02 PM
You mention that "it doesn't highlight the correct cells", but you don't explain what the correct cells are.
It sounds like it might be that conditional formatting with formulas like =ISNUMBER(MATCH(K2, AQ:AQ, 0)) would highlight the cells you want.
Additional conditions would get the formatting for the other columns.

estatefinds
08-23-2016, 05:06 PM
ok the correct cells so for example I run module 13 for the column BC for the numbers


5678


5679


5670


5689


5680


5690


5789


5780


5790


5890


6789


6780


6790


6890


7890
so then the numbers that are matching in the range K2:R71 will be highli\ghted the color dark Blue




The way the macro runs now it doesnt highlight the numbers for that column the macro is running on the column BC

estatefinds
08-23-2016, 05:11 PM
so when i run the Module 1 it highlights all the numbers in the range of K2:R71 as they are found in column A.


so now for the modules named 9 to 13 I had placed the column in which the macro looks at the numbers within that column to find match in the range K2:R71 and highlights those numbers the designated color for that module.

I purposely made the module 9 to 13 so I can run them separately as i examine the data easier this way.


Also the Column AH is for another program disregard this column

estatefinds
08-23-2016, 06:47 PM
how could
I get this to highlight the numbers in the range of K2:R71 which are the matching numbers of the Column AQ highlighted with designated color of light blue. everything is in the CODE but highlighting the correct numbers that match what is in column AQ.


Sub Color_cells_In_Range_Or_Sheet()
Dim FirstAddress As String
Dim mySearch As Variant
Dim myColor As Variant
Dim Rng As Range
Dim i As Long, loopCounter As Long
Dim lastRow As Long

lastRow = Range("AQ" & Rows.Count).End(xlUp).Row


For loopCounter = 1 To lastRow
mySearch = Array(Cells(loopCounter, 1).Value)
myColor = Array("17")
If Cells(loopCounter, 1) <> "" Then
With Sheets("Sheet1").Range("K2:R70")
For i = LBound(mySearch) To UBound(mySearch)
Set Rng = .Find(What:=mySearch(i), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rng.Interior.ColorIndex = myColor(i)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next i
End With
End If
Next loopCounter
End Sub

mikerickson
08-23-2016, 08:02 PM
You don't need a separate module for every sub. There can be many routines in one sub.

Your various macros all to the same thing, they look for cells in the DataRange (K2:R71) that have matching values in a range of values and color those cells.
The only thing that changes is the range with the matching values and the color of the cell.

Rather than a separate sub for each situation, you can write a sub that takes ranges as argument and applies the procedure to those arguments.

Sub ColorMatchingCells(ByVal DataRange As Range, ByVal RangeOfMatchingValues As Range, ColorForDataCells As OLE_COLOR)

Then you can write some smaller subs. Like this that mimic's the sub in Module1.


Sub DemoTest()
Dim mRange As Range
With Sheet1.Range("A:A")
Set mRange = Range(.Cells(1, 1), .Cells(Rows.Count).End(xlUp))
End With
Call ColorMatchingCells(Sheet1.Range("K2:R71"), mRange, vbRed)
End Sub

The sub, ColorMatchingCells, does not use ColorIndex, it uses the Color property, so that argument has to be an OLE_Color type. A list of color constants can be found with the Object Browser, either ColorConstants or xlRGBColor. Or you can specify a custom color with the RGB function.

Instead of looping through the range of match values and then through the Data range. This routine loops through the DataRange once, collecting cells that are already the indicated color in one range and those cells that have a match in the other.
After that loop, the first (discontinuous) range is set to no fill in bulk rather than cell by cell, preventing false positive results.
Then the range of matching cells is colored, again in bulk.

All that remains is for you to write routines similar to


Sub MatchToAQ()
Dim mRange As Range
With Sheet1.Range("AQ:AQ")
Set mRange = Range(.Cells(1, 1), .Cells(Rows.Count).End(xlUp))
End With
Call ColorMatchingCells(Sheet1.Range("K2:R71"), mRange, xlrgbTeal)
End Sub


Sub ColorMatchingCells(ByVal DataRange As Range, ByVal RangeOfMatchingValues As Range, ColorForDataCells As OLE_COLOR)
Dim oneCell As Range
Dim counterCells As Range
Dim foundCells As Range

Set DataRange = Application.Intersect(DataRange, DataRange.Parent.UsedRange)
Set RangeOfMatchingValues = Application.Intersect(RangeOfMatchingValues, RangeOfMatchingValues.Parent.UsedRange)

Set foundCells = DataRange.Offset(0, DataRange.Columns.Count + 2).Cells(1, 1)
Set counterCells = foundCells
Application.ScreenUpdating = False
For Each oneCell In DataRange
If oneCell.Interior.Color = ColorForDataCells Then
Set counterCells = Application.Union(counterCells, oneCell)
End If
If oneCell.Value = vbNullString Then
Rem empty cell, do nothing
Else
If WorksheetFunction.CountIf(RangeOfMatchingValues, oneCell) = 0 Then
Rem no match
Else
Rem no match
Set foundCells = Application.Union(oneCell, foundCells)
End If
End If
Next oneCell

On Error Resume Next
Rem clear old colored cells
Application.Intersect(DataRange, counterCells).Interior.ColorIndex = xlNone
Rem color new matching cells
Application.Intersect(DataRange, foundCells).Interior.Color = ColorForDataCells
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

estatefinds
08-23-2016, 09:17 PM
Ok I added the macro with the other Subs and it seems like its doing what it suppossed to. I'll look at this tomorrow.
Thank you Again!
I appreciate it!:)