Swapping between sheets & using Find
 

Dick,
Thanks for your help,I will give it a go today and see how I get on.
Neil

"Dick Kusleika" wrote in message
...
Neil

Selecting and Activating slow down code more than anything else. I didn't
go through your code with a fine tooth comb, but you I don't believe there
is any reason for you to select. You need to rewrite it with no Select or
Activate methods. Here's a short example

Dim FoundDataRng as Range
Dim FoundMainRng as Range

Set FoundDataRng = Sheets("Data").Cells.Find(....)

If Not FoundDataRng Is Nothing Then
Set FoundMainRng =
Sheets("Main").Cells.Find(FoundDataRange.Value,... .)
If Not FoundMainRng Is Nothing Then
'Now you have two variables that refer to the cells you were
looking
for. You
'can change anything you want about these cells, and you haven't
selected
'anything
FoundDataRng.Font.Bold = True
FoundMainRng.Font.ColorIndex = 3
'etc.
End If
End If

Give it a try and post back if you need more help.

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com

"Neil" wrote in message
...
Hi!,

I have two worksheets, Main and Data. Main is list of summarised data
from
the Data sheet.
I search through the Data sheet for certain conditions and if met then
search for a corresponding number in the Main sheet and add some value
to
the end of that row.
This all works OK but I was wondering if there was a better way of doing
it
then swapping between sheets as it seems to slow it down a bit or is
there
a
better way of doing the whole thing.

Neil.

Sub OverHours()
Dim cel As Range
Dim counter As Long
Dim Finalrow As Long
Dim Lookfor As String 'value to look for in Sheet
1(Main)
Application.ScreenUpdating = False
Finalrow = Cells(65536, 2).End(xlUp).Row
counter = Finalrow
Activate2 = True 'Public flag to turn off sheet 2 worksheet
activate event
For Each cel In Worksheets(2).Range("B1:B" & Finalrow)
Select Case Right(cel.Value, 2)
Case "CS", "QW", "AH", "WA", "CD"
If cel.Offset(0, 8).Value < 0.18 Then
Cells.Find(what:="Contract:", after:=cel, _
LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows,
searchdirection:=xlPrevious, _
MatchCase:=False).Activate
'As I only need to copy the value once not every time
' it meets the condition in the same range.
If ActiveCell.Offset(0, 2).Font.ColorIndex < 5 Then
With Range("C" & ActiveCell.Row).Font
.Bold = True
.ColorIndex = 5
End With
Lookfor = ActiveCell.Offset(0, 1).Value
Sheets(1).Activate
Cells.Find(what:=Lookfor, after:=ActiveCell, _
LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows,
searchdirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 9).Value = 1
Sheets(2).Activate
End If
End If
Case "PM"
If cel.Offset(0, 10).Value < cel.Offset(0, 9).Value / 2 Or _
cel.Offset(0, 10).Value cel.Offset(0, 9).Value Then
Cells.Find(what:="Contract:", after:=cel, _
LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows,
searchdirection:=xlPrevious, _
MatchCase:=False).Activate
If ActiveCell.Offset(0, 1).Font.ColorIndex < 3 Then
With Range("B" & ActiveCell.Row).Font
.Bold = True
.ColorIndex = 3
End With
Lookfor = ActiveCell.Offset(0, 1).Value
Sheets(1).Activate
Cells.Find(what:=Lookfor, after:=ActiveCell, _
LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows,
searchdirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 10).Value = 2
Sheets(2).Activate
End If
End If
End Select
counter = counter - 1
Application.StatusBar = "Checking Data in row " & counter
Next
Application.StatusBar = False
Application.ScreenUpdating = True
Activate2 = False
End Sub