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

[SamT]

Didn't we go over this before?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
     
    If Target.Address = "$C$2:$M$3" Then
        Application.StatusBar = "Created by:" & Target.Cells(1)
        Exit Sub
    End If
     
    If Intersect(Target, Rows("9:28")) Is Nothing Then Exit Sub
    
    Select Case Target.Column
    Case 2: SubB Target
    Case 5, 6: SubEF Target
    Case 9 To 12: SubItoL Target
    End Select
    
End Sub

Private Sub SubB(Target As Range)
'Code to work on Coumn B
End Sub

Private Sub SubEF(Target As Range)
'Same As Above For columns F & E
'repeat As needed
End Sub

This

   sr = Selection.Row 
    sc = Selection.Column 
    Inquiry = Cells(sr, sc)

Is the same as This

Inquiry = Target

And This

VLookup(Inquiry, [PN_STATUS], 2, 0)

Is the Same As This

VLookup(Target, [PN_STATUS], 2, 0)

And Finally, unless you have changed your VLookUp Tables, you can't use the same criteria for different Tables

[Nick72310]

Private Sub SubB(Target As Range)       'Code to work on Coumn B End Sub    Private Sub SubEF(Target As Range)       'Same As Above For columns F & E      'repeat As needed End Sub

I don't understand what the "Code to work on Column B" is. I tried the code below but that doesn't work. It just doesn't do anything. No error or result.

Private Sub SubB(Target As Range)
Dim MyDesc1 As Range
MyDesc1 = Application.WorksheetFunction.VLookup(Target, [PN_STATUS], 2, 0)
Application.StatusBar = Target & " - " & MyDesc1
End Sub

[SamT]

If you use the VBA Menu >> Debug >> Compile, it will tell you that there is a type mismatch in the VLookup Line.



Because you have declared MyDesc1 as a Range, but Vlookup returns a Value.



Debug>> Compile is the first step in troubleshooting. I use it many time while writing a single sub.

[Nick72310]

So how do I fix it? What should the code be for my sub?

[Nick72310]

This is what I ended up doing...

'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,D9:D28,I9:L28,E9:F28")) Is Nothing Then Exit Sub 'Entire Range for Status Bar Display
    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("$E$9:$E$28")) Is Nothing Then Exit Sub
        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
        
If Intersect(Target, Range("$D$9:$D$28")) Is Nothing Then Exit Sub
        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."

Exit Sub
End Sub

[SamT]

I guess you know best.

[Nick72310]

It works...

I guess you know best.

[SamT]

Select a Cell in D

[Nick72310]

Works Every time... Because I know best.

'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,D9:D28,I9:L28,E9:E28")) Is Nothing Then Exit Sub 'Entire Range for Status Bar Display
    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)
    MyDesc5 = Application.WorksheetFunction.VLookup(inquiry, [PP], 2, 0)
    
    Application.StatusBar = inquiry & " - " & MyDesc1 & MyDesc2 & MyDesc3 & MyDesc4 & MyDesc5
     
If Intersect(Target, Range("$E$9:$E$28")) Is Nothing Then Exit Sub
        sr = Selection.Row
        sc = Selection.Column
        inquiry = Cells(sr, sc)
        MyDesc6 = Application.WorksheetFunction.VLookup(inquiry, [OIB], 8, 0)
    
        Application.StatusBar = inquiry & ": Quantity On-Hand= " & MyDesc6
Exit Sub
End Sub