VBA code for comparing a worksheet with a column and show the result with a color

[derken73]

Hello, I’m a newbie at programming in VBA So I hope someone here can help me along.

What I’ve been trying to do these last weeks is getting a nice looking overview of empty locations in our warehouse.
I Actually did get it to work(barely) with the conditional formatting function.
However since it has to compare about 9000 locations It grinds my 64bit Excel (i7 with 8GB) to a crawl and finally crashes.
I’ve attached the file I’ve been working with.
On sheet 1 you can see an export of our warehouse management system with all locations that contain material.
On sheet 2 you see the overview of all the possible locations.

My goal is to give all the locations on sheet 2 which have material on it a color.
The empty locations should remain the same.
I hope this is possible with VBA and that it doesn’t crashes excel when I use it


link to the file
http : // dl.dropbox.com/u/350816/empty-locations.xlsx

[Teeroy]

Firstly merged cells in a spreadsheet cause a nightmare with VBA. If you want to use VBA steer away from them. The following works (tested with excel 2003 so less rows/columns) but is quite slow (5 min+ and that's with less rows/columns than you may have in excel 2007/2010) due to the merged cells (it's looping through masses of empty cells). It may not the most efficient way of doing this; but it works .

You will need to unmerge columns Z and AA in sheet "IMPORT BTS VOORRAADLIJST" for this to work.

[vba]
Sub ColourUsedLocations()
Dim rCell As Range
Dim rCheck As Range
Dim rng As Range

'unmerge column Z from column AA
'slow because of merged cells

Application.ScreenUpdating = False
Set rCheck = Sheets("IMPORT BTS VOORRAADLIJST").Columns(26)

With Sheets("KARDEX INDELING")

.Cells.Interior.ColorIndex = xlColorIndexNone

For Each rCell In .UsedRange 'reset colours
If rCell.Value = "" Then GoTo Nextloop
With rCheck
Set rng = .Find(What:=rCell.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If Not rng Is Nothing Then
rCell.Interior.ColorIndex = 4 'green
End If
Nextloop:
Next
End With
Application.ScreenUpdating = True
End Sub
[/vba]