Hide combobox entry options please

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Evening,

I wish to hide two entries in a combobox.
Please can you advise what options are available.

The two entries in question must be in the combobox BUT not shown.
Deleting these two entries isnt an option
 
Sort by date Sort by votes
Kind of works.

I have 3 entries in combobox.

One entry is removed to worksheet.
I then see two names in combobox.
I then remove another entry to worksheet.
Now as opposed to seeing one entry left i actually see all three again.

BUT
If i do it like this it seems much better

3 entries in combobox

One entry is removed to worksheet.
I close then open userform
I then see two names in combobox.
I then remove another entry to worksheet.
I close then open userform.
I now see one entry left so i move it to worksheet.
I then see the no data msgbox.
I close then click open userform but told no data which is correct.

So it works as long as userform is closed / open as shown above.
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Ok
This works but needs cleaning up / writing correctly + one other thing which i will mention.

Please take not of red text.

Code: 
Private Sub UserForm_Initialize()  Dim cl As Range, rng As Range, lstrw As Long, lastrow As Long, Lastrowa As Long, cntr As Integer
  '==============================================================================================
  Application.ScreenUpdating = False
  lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
  Sheets("POSTAGE").Cells(8, 2).Resize(lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
  Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
  CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  cntr = 1
  With Sheets("POSTAGE")
    lstrw = .Range("B65536").End(xlUp).Row
    Set rng = .Range("B8:B" & lstrw)
    For Each cl In rng
      If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1
    Next
    If cntr = 1 Then
      MsgBox "No data"
      Unload PostageTransferSheet
    ElseIf cntr = 2 Then
      NameForDateEntryBox.AddItem .Range("L1").Value
    Else
      .Range("L1:L" & cntr - 1).Sort key1:=.Range("L1"), order1:=xlAscending, Header:=xlNo
      NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
      .Range("L1:L" & cntr - 1).Clear
      TextBox2.SetFocus
    End If
  End With
  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub


Code: 
Private Sub DateTransferButton_Click()'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String, res As Variant
    
    If NameForDateEntryBox.ListIndex = -1 Then
        MsgBox "Please Select A Customer Before Transfer Button", vbCritical, "Delivery Parcel Date Transfer"
        Exit Sub
    End If
    
    If TextBox7.Value = "" Or Not IsDate(TextBox7.Value) Then
        MsgBox "Please Enter A Valid Date", vbCritical, "Delivery Parcel Date Transfer"
        TextBox7 = ""
        TextBox7.SetFocus
        Exit Sub
    End If
    
    wName = NameForDateEntryBox.List(NameForDateEntryBox.ListIndex)
    Set sh = Sheets("POSTAGE")
    Set b = sh.Columns("B").Find(wName, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        If sh.Cells(b.Row, "G").Value <> "" Then
            MsgBox "DATE HAS BEEN ENTERED ALREADY !" & vbCrLf & "CLICK OK TO GO CHECK IT OUT", vbCritical, "Delivery Parcel Date Transfer"
            TextBox7 = ""
            Unload PostageTransferSheet
            Cells(b.Row, "G").Select
        Else
            sh.Cells(b.Row, "G").Value = CDate(TextBox7.Value)
            sh.Cells(b.Row, "G").Interior.Color = vbYellow
            MsgBox "Delivery Date Updated", vbInformation, "Delivery Parcel Date Transfer"
[COLOR=#ff0000]            Unload PostageTransferSheet
            PostageTransferSheet.Show[/COLOR]
            
        End If
    End If
    NameForDateEntryBox = ""
    TextBox7 = ""
    TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub

Now once the combobox is empy i see the NO DATA message BUT when i click OK it then opens up the userform again so i see an error,
this from,
the PrivateSub DateTransferButton
PostageTransferSheet.Show is in yellow.

How can we edit the code so when the combobox is empy & i click ok to the NO DATA message it then cancels trying to open it again
 
Upvote 0
Not sure this will help you but:

If you want to enter a ListBox item into column A of the active sheet.
And then remove that value from the Listbox

I would put this script into a Button

Then select the value in the listbox you want entered into column A

And then Press the button.

The script will now enter the value selected in the listbox into column A
And the value in the listbox will be removed from the listbox.
Code: 
Private Sub CommandButton1_Click()
'Modified  10/11/2019  12:19:09 AM  EDT
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(Lastrow, 1).Value = ListBox1.Value
    For i = ListBox1.ListCount - 1 To 0 Step -1
        If ListBox1.Selected(i) Then ListBox1.RemoveItem i
    Next
End Sub
 
Upvote 0
Hi,

I have a msgbox appear in my original code shown below where once i click OK userform still opens.
At this point there is no need for it to open if the NO DATA message is shown so im just trying to stop it.
I have supplied the same code with my edit which i thought would do it shown in Red but i dont get to see the message this time as no records are even shown in the drop down list.
How is this then correctly written ?

Thanks

Here is the original code.

Code: 
Private Sub UserForm_Initialize()
  Dim cl As Range, rng As Range, lstrw As Long, Lastrow As Long, Lastrowa As Long, cntr As Integer
 
  Application.ScreenUpdating = False
  Lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
  Sheets("POSTAGE").Cells(8, 2).Resize(Lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
  Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
  CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
 
  cntr = 1
  With Sheets("POSTAGE")
    lstrw = .Range("B65536").End(xlUp).Row
    Set rng = .Range("B8:B" & lstrw)
    For Each cl In rng
      If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1
    Next
    If cntr = 1 Then
      MsgBox "No data"
    ElseIf cntr = 2 Then
      NameForDateEntryBox.AddItem .Range("L1").Value
    Else
      .Range("L1:L" & cntr - 1).Sort key1:=.Range("L1"), order1:=xlAscending, Header:=xlNo
      NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
      .Range("L1:L" & cntr - 1).Clear
      TextBox2.SetFocus
    End If
  End With
 
  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub


Here is my edited code shown in Red

Code: 
Private Sub UserForm_Initialize()
  Dim cl As Range, rng As Range, lstrw As Long, Lastrow As Long, Lastrowa As Long, cntr As Integer


  Application.ScreenUpdating = False
  Lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
  Sheets("POSTAGE").Cells(8, 2).Resize(Lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
  Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
  CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
  
  cntr = 1
  With Sheets("POSTAGE")
    lstrw = .Range("B65536").End(xlUp).Row
    Set rng = .Range("B8:B" & lstrw)
    For Each cl In rng
      If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1
    Next
    If cntr = 2 Then
[COLOR=#FF0000]     Reply = MsgBox("NO DATA")[/COLOR]
[COLOR=#FF0000]    If Reply = vbYes Then[/COLOR]
[COLOR=#FF0000]    Exit Sub[/COLOR]
    ElseIf cntr = 2 Then


      NameForDateEntryBox.AddItem .Range("L1").Value
    Else
      .Range("L1:L" & cntr - 1).Sort key1:=.Range("L1"), order1:=xlAscending, Header:=xlNo
      NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
      .Range("L1:L" & cntr - 1).Clear
      TextBox2.SetFocus
    End If
    End If
  End With
  
  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Locked
  • Question
additional pop up msgbox dependent on specific text entered into userform combobox, and other questions
Replies
2
Views
252
Peter_SSs
Peter_SSs
W
  • Solved
pop up msgbox dependent on specific text entered into userform combobox
Replies
3
Views
263
Wishful Thinking
W
M
  • Solved
Using ComboBox Tag property to simply code
Replies
5
Views
375
RoryA
RoryA
J
  • Solved
Option Buttons
Replies
6
Views
340
JP801
J
J
  • Question
Excel VBA Help
2
Replies
11
Views
297
justincaza
J

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top