Status Bar Display

**Nick72310** · 11-19-2015, 10:24 AM

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** · 11-19-2015, 04:09 PM

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** · 11-20-2015, 01:45 AM

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** · 11-20-2015, 07:50 AM

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.
VBA Help 4 - Thank You!.xlsm

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** · 11-20-2015, 08:30 AM

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** · 11-20-2015, 08:52 AM

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

28 then.

Originally Posted by xld

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** · 11-20-2015, 09:50 AM

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** · 11-20-2015, 01:20 PM

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

Originally Posted by 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

**snb** · 11-20-2015, 01:49 PM

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

**Nick72310** · 11-20-2015, 02:05 PM

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

Originally Posted by snb

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

**SamT** · 11-20-2015, 02:31 PM

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

Yes, that helps me understand the problem... Not.

**Nick72310** · 11-20-2015, 02:42 PM

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** · 11-20-2015, 05:14 PM

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** · 11-24-2015, 08:41 AM

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.

Originally Posted by SamT

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.

Thread: Status Bar Display

Thread Tools

Display

Status Bar Display

Tags for this Thread

Posting Permissions