Robb????

Posted by QWERTY on September 19, 2001 2:46 AM

Hey Robb!!!

You helped me out with a problem lately about looking up a value which could have more than 1 different value behind which to show them all looking for the first value! Know I was thinking do you know if it's possible to put a messagebox in it when the value isn't found? A messagebox which says "Fill in an existing client number"! Hope you can help me out AGAIN? Thanks!

QWERTY

Posted by Robb on September 19, 2001 4:15 AM

I've added a message box to display if initial search is unsuccessful.

Here's all the code again - it's included toward the end as the "else" part of the "if" statement.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")
If Not Application.Intersect(Target, sh2.[D4]) Is Nothing Then
Dim Cust
Cust = sh2.[D4]
With sh1
.Cells(2, 1).ClearContents
For Each c In .[A5, A8, E2, E8, G8]
If c &LT;&GT; "" Then
If c.Offset(1, 0) &LT;&GT; "" Then
.Range(c, c.End(xlDown)).Clear
Else
c.Clear
End If
Else
End If
Next c
Dim n As Integer, o As Integer, p As Integer, q As Integer, r As Integer
n = 0
o = 0
p = 0
q = 0
r = 0
Set c = .Columns(1).Find(Cust, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not c Is Nothing Then
c.Copy Destination:=.[A2]
Do
If c.Address = "\$A\$2" Then GoTo Fin
If c.Offset(0, 1) &LT;&GT; "" Then
c.Offset(0, 1).Copy Destination:=.[E2].Offset(n, 0)
n = n + 1
Else
End If
If c.Offset(0, 2) &LT;&GT; "" Then
c.Offset(0, 2).Copy Destination:=.[A5].Offset(o, 0)
o = o + 1
Else
End If
If c.Offset(0, 3) &LT;&GT; "" Then
c.Offset(0, 3).Copy Destination:=.[A8].Offset(p, 0)
p = p + 1
Else
End If
If c.Offset(0, 4) &LT;&GT; "" Then
c.Offset(0, 4).Copy Destination:=.[E8].Offset(q, 0)
q = q + 1
Else
End If
If c.Offset(0, 5) &LT;&GT; "" Then
c.Offset(0, 5).Copy Destination:=.[G8].Offset(r, 0)
r = r + 1
Else
End If
Set c = .Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address &LT;&GT; firstc
Else
Dim strNFMsg As String, strNFTitle As String, NF
strNFMsg = "Please fill in an existing client number."
NF = MsgBox(prompt:=strNFMsg, Title:=strNFTitle, Buttons:=48)
End If
End With
End If
Fin:
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

Does that do the trick?

Regards

Posted by QWERTY on September 19, 2001 4:52 AM

Thanks! I see the messagebox appear but when I fill in a value that it did found and it goes to the next sheet when I wanna go back then to fill in another one it gives that message also by going back! Do you know how I can skip that message by going back? Thanks!

QWERTY

: Hey Robb!!!

Posted by Robb on September 19, 2001 1:19 PM

I have tried the code and I cannot get it to do what you seem
to be saying.

Code should be only in Sheet2 - have you put it anywhere else. Also, have you added anything to the code?

Regards

Thanks! I see the messagebox appear but when I fill in a value that it did found and it goes to the next sheet when I wanna go back then to fill in another one it gives that message also by going back! Do you know how I can skip that message by going back? Thanks! : Dim sh1 As Worksheet, sh2 As Worksheet : Set sh1 = ThisWorkbook.Worksheets("Sheet1") : Set sh2 = ThisWorkbook.Worksheets("Sheet2") : If Not Application.Intersect(Target, sh2.[D4]) Is Nothing Then : Dim Cust : Cust = sh2.[D4] : With sh1 : .Cells(2, 1).ClearContents : For Each c In .[A5, A8, E2, E8, G8] : If c &LT;&GT; "" Then : If c.Offset(1, 0) &LT;&GT; "" Then : .Range(c, c.End(xlDown)).Clear : Else : c.Clear : End If : Else : End If : Next c : Dim n As Integer, o As Integer, p As Integer, q As Integer, r As Integer : n = 0 : o = 0 : p = 0 : q = 0 : r = 0 : Set c = .Columns(1).Find(Cust, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True) : If Not c Is Nothing Then : firstc = c.Address : c.Copy Destination:=.[A2] : Do : If c.Address = "\$A\$2" Then GoTo Fin : If c.Offset(0, 1) &LT;&GT; "" Then : c.Offset(0, 1).Copy Destination:=.[E2].Offset(n, 0) : n = n + 1 : Else : End If : If c.Offset(0, 2) &LT;&GT; "" Then : c.Offset(0, 2).Copy Destination:=.[A5].Offset(o, 0) : o = o + 1 : Else : End If : If c.Offset(0, 3) &LT;&GT; "" Then : c.Offset(0, 3).Copy Destination:=.[A8].Offset(p, 0) : p = p + 1 : Else : End If : If c.Offset(0, 4) &LT;&GT; "" Then : c.Offset(0, 4).Copy Destination:=.[E8].Offset(q, 0) : q = q + 1 : Else : End If : If c.Offset(0, 5) &LT;&GT; "" Then : c.Offset(0, 5).Copy Destination:=.[G8].Offset(r, 0) : r = r + 1 : Else : End If : Set c = .Columns(1).FindNext(c) : Loop While Not c Is Nothing And c.Address &LT;&GT; firstc : Else : Dim strNFMsg As String, strNFTitle As String, NF : strNFMsg = "Please fill in an existing client number." : strNFTitle = "Client number not found." : NF = MsgBox(prompt:=strNFMsg, Title:=strNFTitle, Buttons:=48) : End If : End With : End If : Fin

Posted by QWERTY on September 20, 2001 1:35 AM

Hey,

I already fixed it! I had to let it show the hidden columns again! Thanks! I have tried the code and I cannot get it to do what you seem to be saying. Code should be only in Sheet2 - have you put it anywhere else. Also, have you added anything to the code?

: Thanks! I see the messagebox appear but when I fill in a value that it did found and it goes to the next sheet when I wanna go back then to fill in another one it gives that message also by going back! Do you know how I can skip that message by going back? Thanks!