Status Bar Display

[Nick72310]

I am trying to customize my status bar using "Private Sub Worksheet_SelectionChange(ByVal Target As Range)". Each column has a separate message I would like to convey to the user. My code is shown below, but it is not coded very well and it's obviously not working correctly. I'm a little confused what to do with all the different "ifs" for the columns. I would appreciate some help. Thank you!

Some cells may be blank, so if there was a way to exclude those, that would be great!


'Status Bar Display

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next

If Target.Address = "$C$2:$M$3" Then
Application.StatusBar = "Created by: ..."
Exit Sub
End If

If Intersect(Target, Range("B9:B28,E9:F28,I9:L28")) Is Nothing Then Exit Sub
sr = Selection.Row
sc = Selection.Column
Inquiry = Cells(sr, sc)
MyDesc1 = Application.WorksheetFunction.VLookup(Inquiry, [PN_STATUS], 2, 0)
MyDesc2 = Application.WorksheetFunction.VLookup(Inquiry, [SUPPLY_TYPE], 2, 0)
MyDesc3 = Application.WorksheetFunction.VLookup(Inquiry, [UOM], 2, 0)
MyDesc4 = Application.WorksheetFunction.VLookup(Inquiry, [MAKE_BUY], 2, 0)

Application.StatusBar = Inquiry & " - " & MyDesc1 & MyDesc2 & MyDesc3 & MyDesc4

If Intersect(Target, Range("E9:F28")) Is Nothing Then Exit Sub
If IsEmpty(Range("$E$9:$F$28").Value) = False Then
sr = Selection.Row
sc = Selection.Column
Inquiry = Cells(sr, sc)
MyDesc5 = Application.WorksheetFunction.VLookup(Inquiry, [OIB], 8, 0)

Application.StatusBar = Inquiry & ": Quantity On-Hand=" & MyDesc5
End If

If Intersect(Target, Range("D9:D28")) Is Nothing Then Exit Sub
If Range("D9:D28").Value = PP Then
sr = Selection.Row
sc = Selection.Column
Inquiry = Cells(sr, sc)

Application.StatusBar = Inquiry & ": New Piece Part Setup needs to take place for this Part Number."
End If

Exit Sub
End Sub

[Bob Phillips]

I've simplified it and added some comments. Is this any better?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("$C$2:$M$3")) Is Nothing Then

Application.StatusBar = "Created by: ..."
Else

sr = Target.Row
sc = Target.Column
Inquiry = Me.Cells(sr, sc)

If Not Intersect(Target, Me.Range("B9:B28,E9:F28,I9:L28")) Is Nothing Then

MyDesc1 = Application.VLookup(Inquiry, [PN_STATUS], 2, 0)
MyDesc2 = Application.VLookup(Inquiry, [SUPPLY_TYPE], 2, 0)
MyDesc3 = Application.VLookup(Inquiry, [UOM], 2, 0)
MyDesc4 = Application.VLookup(Inquiry, [MAKE_BUY], 2, 0)

Application.StatusBar = Inquiry & " - " & MyDesc1 & MyDesc2 & MyDesc3 & MyDesc4

ElseIf Not Intersect(Target, Me.Range("E9:F28")) Is Nothing Then

'<<<<<<<<<<< You can't test multi-cells, need another approach
'If IsEmpty(Range("$E$9:$F$28").Value) = False Then
If Application.CountIf(Me.Range("$E$9:$F$28"), "<>") > 0 Then

MyDesc5 = Application.VLookup(Inquiry, [OIB], 8, 0)

Application.StatusBar = Inquiry & ": Quantity On-Hand=" & MyDesc5
End If

ElseIf Not Intersect(Target, Me.Range("D9:D28")) Is Nothing Then

If Me.Range("D9:D28").Value = [PP] Then '<<<<<<<<<<<<<<<< is this [PP] or if PP where is that defined

Application.StatusBar = Inquiry & ": New Piece Part Setup needs to take place for this Part Number."
End If
End If
End If
End Sub

[snb]

Or


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$2:$M$3" Then c00= "Created by: ..."

If not Intersect(Target, Range("B9:B28,I9:L28")) Is Nothing Then
with application
c00= Inquiry & " - " & .VLookup(target, [PN_STATUS], 2, 0) & .VLookup(target, [SUPPLY_TYPE], 2, 0) & .VLookup(target, [UOM], 2, 0) & .VLookup(target, [MAKE_BUY], 2, 0)
end with
end if

If not Intersect(Target, Range("E9:F28")) Is Nothing Then
If target<>"" Then c00= target & ": Quantity On-Hand=" & Application.VLookup(target, [OIB], 8, 0)
End If

If not Intersect(Target, Range("D9:D28")) Is Nothing Then
If target.Value = PP Then c00 = Target & ": New Piece Part Setup needs to take place for this Part Number."
End If

Application.StatusBar=c00
End Sub

[Nick72310]

To both,
Thank you for the quick response... Unfortunately, neither of them worked 100%. Cells C2:M3 work correctly, and D9:28 kind of works. I decided to attach a file below. Keep in mind, I will want to add more "target ranges" in the future.
14806


xld:
PP is a value from a formula in the column of cells.

=IF(ISBLANK(E9),"",IF(ISERROR(VLOOKUP($E9,ITEM_NUMBER,1,0)),"PP",""))

[Bob Phillips]

If PP is a cell value you cannot use PP as a VBA variable, you should either pick up that cell value or use it as a string (in quotes).

[Nick72310]

Okay. I think I am okay with it just always appearing in cells D9:D28 then.


If PP is a cell value you cannot use PP as a VBA variable, you should either pick up that cell value or use it as a string (in quotes).

[SamT]

Yet another try

Option Explicit

'Status Bar Display

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'For help See: http://www.vbaexpress.com/forum/showthread.php?54328

If Target.Address = "$C$2:$M$3" Then
Application.StatusBar = "Created by: ..."
Exit Sub
End If

If Target.Count > 1 Then Exit Sub

'Removed ",E9:F28" handled in next "IF"
If Not Intersect(Target, Range("B9:B28, I9:L28")) Is Nothing Then
DisplayAll Target
Exit Sub
End If


If Not Intersect(Target, Range("E9:F28")) Is Nothing And Target <> "" Then
Application.StatusBar = Target.Value & ": Quantity On-Hand= " & Application.WorksheetFunction.VLookup(Target.Value, [OIB], 8, 0)
Exit Sub
End If

If Not Intersect(Target, Range("D9:D28")) Is Nothing And Target.Value = "PP" Then
Application.StatusBar = Target.Value & ": New Piece Part Setup needs to take place for this Part Number."
Exit Sub
End If

End Sub

Private Sub DisplayAll(Target As Range)
Dim strDisplay As String
Dim strRef As String

strRef = Target.Value
strDisplay = strRef
With Application.WorksheetFunction
strDisplay = strDisplay & " - " & .VLookup(strRef, [PN_STATUS], 2, 0)
strDisplay = strDisplay & .VLookup(strRef, [SUPPLY_TYPE], 2, 0)
strDisplay = strDisplay & .VLookup(strRef, [UOM], 2, 0)
Application.StatusBar = strDisplay & .VLookup(strRef, [MAKE_BUY], 2, 0)
End With
End Sub

[Nick72310]

Thank you, but that did not work either. Only Cells C2:M3 worked correctly.


Yet another try

Option Explicit

'Status Bar Display

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'For help See: http://www.vbaexpress.com/forum/showthread.php?54328

If Target.Address = "$C$2:$M$3" Then
Application.StatusBar = "Created by: ..."
Exit Sub
End If

If Target.Count > 1 Then Exit Sub

'Removed ",E9:F28" handled in next "IF"
If Not Intersect(Target, Range("B9:B28, I9:L28")) Is Nothing Then
DisplayAll Target
Exit Sub
End If


If Not Intersect(Target, Range("E9:F28")) Is Nothing And Target <> "" Then
Application.StatusBar = Target.Value & ": Quantity On-Hand= " & Application.WorksheetFunction.VLookup(Target.Value, [OIB], 8, 0)
Exit Sub
End If

If Not Intersect(Target, Range("D9:D28")) Is Nothing And Target.Value = "PP" Then
Application.StatusBar = Target.Value & ": New Piece Part Setup needs to take place for this Part Number."
Exit Sub
End If

End Sub

Private Sub DisplayAll(Target As Range)
Dim strDisplay As String
Dim strRef As String

strRef = Target.Value
strDisplay = strRef
With Application.WorksheetFunction
strDisplay = strDisplay & " - " & .VLookup(strRef, [PN_STATUS], 2, 0)
strDisplay = strDisplay & .VLookup(strRef, [SUPPLY_TYPE], 2, 0)
strDisplay = strDisplay & .VLookup(strRef, [UOM], 2, 0)
Application.StatusBar = strDisplay & .VLookup(strRef, [MAKE_BUY], 2, 0)
End With
End Sub

[snb]

General advice: refrain from merged cells in VBA. They are only causing trouble/unexpected results.

[Nick72310]

I know but unfortunately I am stuck with the merged cells...


General advice: refrain from merged cells in VBA. They are only causing trouble/unexpected results.

[SamT]

Thank you, but that did not work either. Only Cells C2:M3 worked correctly
Yes, that helps me understand the problem... Not.

[Nick72310]

The problem is that is did not work. It error'd out every time I switched to those cells, other than C2:M3.
No need to be rude...

[SamT]

The problem is that is did not work. It error'd out every time I switched to those cells, other than C2:M3.
No need to be rude...
Excuse me? We are trying to help you. We are the ones giving favors, not you.

Anyway, I found the problem and know the solution. When you figure it out, come back and talk to me in an informative way.

Bye now.

.

.

.

.

.

Ahh, well, I've done the work (for the last 3 hours, you ingrate,) I might as well leave you with at least one clue to one problem.


MyDesc1 = Application.WorksheetFunction.VLookup(Inquiry, [PN_STATUS], 2, 0)
MyDesc2 = Application.WorksheetFunction.VLookup(Inquiry, [SUPPLY_TYPE], 2, 0)
MyDesc3 = Application.WorksheetFunction.VLookup(Inquiry, [UOM], 2, 0)
MyDesc4 = Application.WorksheetFunction.VLookup(Inquiry, [MAKE_BUY], 2, 0)

Note to all: Each [bracketed Name] is a different table.

[Nick72310]

Who said I wasn't appreciative of people helping me? In fact I said thank you to you... I just didn't appreciate your rude comment.


Excuse me? We are trying to help you. We are the ones giving favors, not you.

Anyway, I found the problem and know the solution. When you figure it out, come back and talk to me in an informative way.

Bye now.

.

.

.

.

.

Ahh, well, I've done the work (for the last 3 hours, you ingrate,) I might as well leave you with at least one clue to one problem.


MyDesc1 = Application.WorksheetFunction.VLookup(Inquiry, [PN_STATUS], 2, 0)
MyDesc2 = Application.WorksheetFunction.VLookup(Inquiry, [SUPPLY_TYPE], 2, 0)
MyDesc3 = Application.WorksheetFunction.VLookup(Inquiry, [UOM], 2, 0)
MyDesc4 = Application.WorksheetFunction.VLookup(Inquiry, [MAKE_BUY], 2, 0)

Note to all: Each [bracketed Name] is a different table.