View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Mike Mike is offline
external usenet poster
 
Posts: 3,101
Default a little complicated programming, help would be appreciated!

Tom,
Your adjustment in the code had worked (never doubted you!) but do you know
how i can also write into it so that the highlighted section becomes active,
so i dont have to search the sheets to see if a name has been highlighted?

"Tom Ogilvy" wrote:

Appropriate corrections have been made:

There is very little in Excel that supports NULL. While it may have worked,
I changed the colorindex assignment to xlNone which is the proper constants.

You problem is you are not qualifying ROWS. So they refer to the active
sheet. I have added qualifiers.

Sub auto_open()
Dim start, x, y, FR
Dim sh1 as Worksheet, sh2 as worksheet
set sh1 = Worksheets("SHEET ONE")
set sh2 = Worksheets("SHEET TWO"
start = "Do you wish to use the Search Tool?"
x = vbOKCancel + vbQuestion + vbDefaultButton1
y = "TITLE"
FR = MsgBox(start, x, y)
If FR = vbOK Then
Dim Msg, style, Title, Help, Ctxt, Response, MyString
Msg = "MESSAGE."
style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "TITLE"
Response = MsgBox(Msg, style, Title)
If Response = vbYes Then
Dim answer As String
answer = InputBox(INPUTBOX)
If answer = Empty Then
MsgBox Prompt:= MESSAGE
Else
With Worksheets("SHEET ONE").Range("e2:e500")
Set c = .Find(answer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
sh1.Rows(c.Row & ":" & c.Row).Interior.ColorIndex = 8
Set d = Worksheets("SHEET ONE").Range("M2:IV500")
d.Interior.ColorIndex = xlNone
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
With Worksheets("SHEET TWO").Range("e2:e500")
Set c = .Find(answer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
sh2.Rows(c.Row & ":" & c.Row).Interior.ColorIndex = 8
Set d = Worksheets("SHEET TWO").Range("M2:IV500")
d.Interior.ColorIndex = xlNone
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End If
Else
Dim Cname As String
Cname = InputBox(INPUTBOX)
If Cname = Empty Then
MsgBox Prompt:=MESSAGE
Else
With Worksheets("SHEET ONE").Range("d4:d100")
Set z = .Find(Cname, LookIn:=xlValues)
If Not z Is Nothing Then
firstAddress = z.Address
Do
sh1.Rows(z.Row & ":" & z.Row).Interior.ColorIndex = 8
Set y = Worksheets("SHEET ONE").Range("M2:IV500")
y.Interior.ColorIndex = xlNone
Set z = .FindNext(z)
Loop While Not z Is Nothing And z.Address < firstAddress
End If
End With
With Worksheets("SHEET TWO").Range("d2:d100")
Set w = .Find(Cname, LookIn:=xlValues)
If Not w Is Nothing Then
firstAddress = w.Address
Do
sh2.Rows(w.Row & ":" & w.Row).Interior.ColorIndex = 8
Set v = Worksheets("SHEET TWO").Range("M2:IV500")
v.Interior.ColorIndex = xlNone
Set w = .FindNext(w)
Loop While Not w Is Nothing And w.Address < firstAddress
End If
End With
End If
End If
End If
End Sub

--
Regards,
Tom Ogilvy

"mike" wrote in message
...
Good Question.... here is the code as it stands....

Sub auto_open()
Dim start, x, y, FR
start = "Do you wish to use the Search Tool?"
x = vbOKCancel + vbQuestion + vbDefaultButton1
y = "TITLE"
FR = MsgBox(start, x, y)
If FR = vbOK Then
Dim Msg, style, Title, Help, Ctxt, Response, MyString
Msg = "MESSAGE."
style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "TITLE"
Response = MsgBox(Msg, style, Title)
If Response = vbYes Then
Dim answer As String
answer = InputBox(INPUTBOX)
If answer = Empty Then
MsgBox Prompt:= MESSAGE
Else
With Worksheets("SHEET ONE").Range("e2:e500")
Set c = .Find(answer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Rows(c.Row & ":" & c.Row).Interior.ColorIndex = 8
Set d = Worksheets("SHEET ONE").Range("M2:IV500")
d.Interior.ColorIndex = Null
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
With Worksheets("SHEET TWO").Range("e2:e500")
Set c = .Find(answer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Rows(c.Row & ":" & c.Row).Interior.ColorIndex = 8
Set d = Worksheets("SHEET TWO").Range("M2:IV500")
d.Interior.ColorIndex = Null
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End If
Else
Dim Cname As String
Cname = InputBox(INPUTBOX)
If Cname = Empty Then
MsgBox Prompt:=MESSAGE
Else
With Worksheets("SHEET ONE").Range("d4:d100")
Set z = .Find(Cname, LookIn:=xlValues)
If Not z Is Nothing Then
firstAddress = z.Address
Do
Rows(z.Row & ":" & z.Row).Interior.ColorIndex = 8
Set y = Worksheets("SHEET ONE").Range("M2:IV500")
y.Interior.ColorIndex = Null
Set z = .FindNext(z)
Loop While Not z Is Nothing And z.Address < firstAddress
End If
End With
With Worksheets("SHEET TWO").Range("d2:d100")
Set w = .Find(Cname, LookIn:=xlValues)
If Not w Is Nothing Then
firstAddress = w.Address
Do
Rows(w.Row & ":" & w.Row).Interior.ColorIndex = 8
Set v = Worksheets("SHEET TWO").Range("M2:IV500")
v.Interior.ColorIndex = Null
Set w = .FindNext(w)
Loop While Not w Is Nothing And w.Address < firstAddress
End If
End With
End If
End If
End If
End Sub

Thanks Norman, hope you can help.

Mike


"Norman Jones" wrote:

Hi Mike,

How is the macro to know which sheet should be searched?

---
Regards,
Norman



"mike" wrote in message
...
good morning all.

this is a little complicated, so ill start from the beginning....

and before you ask, i dont have access and cant get it, hence why i am
using
excel,

i have a workbook, there are two work sheets which contain various

data,
but
ideally should be kept separate as they are for separate years.

i have written a macro which will search the sheets for a specific

name or
reference number, then will highlight the row where that cell lies.

here is the problem...
if the file opens on sheet one and i search for a specific name which

i
know
is on sheet two, then the corresponding row is highlighted in sheet

one.
how do i write into the code so that it highlights and then makes it
active
so you can see it on sheet two were the actal name is?

if you need to see the code that i have at the moment let me know and

i
will
add it in.
thanks

mike