PDA

View Full Version : Macro Idea for find and edit



jasonk
07-09-2009, 01:16 PM
Hello all!

First time poster,


I am trying to create a macro and have not been successful yet.
Could anyone please give of a solution?

I have a column of cells with text values on sheet 1, and my entire sheet 2 is populated with an array of these text values (3 million +). I would like to create a macro that finds the value on sheet 1 A1 on sheet 2 and changes that cells color to yellow, continuing for every value in sheet 1 column A.

I was trying loop but with no success.

Excel 2003 PC

Any help is greatly appreciated!!

JimmyTheHand
07-09-2009, 01:38 PM
Welcome to VBAX!

Try this. Modify the sheet names (in red) as appropriate.
Sub test()
Dim C As Range, Rng As Range, Hit As Range
Dim Ws1 As Worksheet, Ws2 As Worksheet

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
Set Rng = Ws1.Range("A1", Ws1.Range("A" & Rows.Count).End(xlUp))
For Each C In Rng
Set Hit = Ws2.Cells.Find(what:=C.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Hit Is Nothing Then Hit.Interior.ColorIndex = 6
Next
End Sub

mdmackillop
07-09-2009, 03:02 PM
Can you have more that one "hit" for each search?

Paul_Hossler
07-10-2009, 06:56 PM
This is one way to do it. It uses loops, which will take time.

Hopefully one of the more experienced VBXers will have more elegant approach for us.



Option Explicit
Sub ColorCells()
Dim rConst As Range, rFormula As Range
Dim rCell As Range
Dim i As Long
Application.ScreenUpdating = False
'maybe 2007 only, but needed to avoid all cells inheriting the color
Application.ExtendList = False
Set rConst = Nothing
Set rFormula = Nothing
On Error Resume Next
Set rConst = Worksheets("Sheet2").UsedRange.SpecialCells(xlCellTypeConstants)
Set rFormula = Worksheets("Sheet2").UsedRange.SpecialCells(xlCellTypeFormulas)



If Not rConst Is Nothing Then
For Each rCell In rConst.Cells
i = 0
i = Application.WorksheetFunction.Match(rCell.Value, Worksheets("sheet1").Columns(1), 0)
If i <> 0 Then rCell.Interior.ColorIndex = 6
Next
End If

If Not rFormula Is Nothing Then
For Each rCell In rConst.Cells
i = 0
i = Application.WorksheetFunction.Match(rCell.Value, Worksheets("sheet1").Columns(1), 0)
If i <> 0 Then rCell.Interior.ColorIndex = 6
Next
End If

Application.ScreenUpdating = True
End Sub


Paul