Re-Post Find value of cell in another sheet

[Dave]

I apologize for the the first post, the spelling and not explaining
properly.

Has been a busy day.

Hi

I have about 250 sheets, I'd like to attach 2 macros to 2 buttons."I can do
that"
To find the value of the active cell,
One to search forward "searching in sheets left to right" and one to search
right to left "sheet by sheet"
and for it to stop at the end, meaning if the last cell value is found in
sheet 210 it does not loop and start say sheet 7 were it started.

Thanks In Advance

all the best

Dave

 

[jamescox]

Hi, Dave -

It's been a busy day here, too - and sadly, I'm still not followin
your description of what you are trying to do.

"to find the value of the active cell" - well, the value of the activ
cell is given by:

ActiveCell.Value

so do you mean you want to search the other worksheets for the valu
that the active cell on the current worksheet has?

To me, this looks like it has two parts. First, you need code to d
the Find operation on a single sheet, then you need a way of changin
sheets if the value isn't found on the just-searched sheet.

There *MUST* be a better way to do this, but the first of these sub
seems to be working, and the second has only small changes to the first
Test them and see if they work for you.

Code
-------------------

Public Sub LookLeft()

Dim vSought As Variant
Dim sSheetName As String
Dim iI As Integer

sSheetName = Activesheet.Name
vSought = ActiveCell.Value

ActiveSheet.Previous.Activate
If Err <> 0 Then
MsgBox "Not found looking to worksheets on the left of " & sSheetName
Exit Sub
End If

On Error Resume Next
Err.Raise Number:=vbObjectError + 514

While Err <> 0
On Error GoTo 0
On Error Resume Next
Range("A1").Select
Cells.Find(What:=vSought, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 0 Then
On Error GoTo 0
On Error Resume Next
ActiveSheet.Previous.Activate
If Err <> 0 Then
MsgBox "Not found looking to worksheets on the left of " & sSheetName
Exit Sub
Else
On Error Resume Next
Err.Raise Number:=vbObjectError + 514
End If
End If
Wend

End Sub

-------------------


and

Code
-------------------

Public Sub LookRight()

Dim vSought As Variant
Dim sSheetName As String
Dim iI As Integer

sSheetName = Activesheet.Name
vSought = ActiveCell.Value

ActiveSheet.Next.Activate
If Err <> 0 Then
MsgBox "Not found looking to worksheets on the right of " & sSheetName
Exit Sub
End If

On Error Resume Next
Err.Raise Number:=vbObjectError + 514

While Err <> 0
On Error GoTo 0
On Error Resume Next
Range("A1").Select
Cells.Find(What:=vSought, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 0 Then
On Error GoTo 0
On Error Resume Next
ActiveSheet.Next.Activate
If Err <> 0 Then
MsgBox "Not found looking to worksheets on the right of " & sSheetName
Exit Sub
Else
On Error Resume Next
Err.Raise Number:=vbObjectError + 514
End If
End If
Wend

End Sub

 

[Dave]

Hi James

Sorry for the delay in replying. Had a corrupt registry etc, had to
reinstall windows.

This code works brilliant, and as saved me a lot of time.

Great!

Thanks James

All the best

Dave