Delete worksheet activex listbox

[jrdnoland]

Using Excel 2016, I'm having trouble deleting or even selecting a listbox that I made using this code:



Dim objOLE As OLEObject, objListBox As msforms.ListBox
Set objOLE = Sheet4.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=0, Top:=0, Width:=150, Height:=lstHeight)

' set some properties
With objOLE
' these are properties of the container OLEObject, not the Listbox itself
.Name = "lstComponents"
.ListFillRange = "A1:A9"

Set objListBox = .Object
' toggle visibility to ensure the control is clickable
.Visible = False
.Visible = True
End With
' now we can set the listbox-specific properties
With objListBox
.MultiSelect = fmMultiSelectMulti
.MatchEntry = fmMatchEntryComplete
End With


The listbox won't delete using the shapes collection or by selecting objects (it doesn't even show up).

What type of listbox is this and how do i delete it?

[paulked]

It's an Embedded ListBox. To delete it go int Developer, Design Mode.

It probably isn't visible because the variable 1stHeight is zero. Using Option Explicit would have picked up the un-declared variable in your Dim statements. Set it to 1000 and you'll see the listbox!

[jrdnoland]

It's an Embedded ListBox. To delete it go int Developer, Design Mode.

It probably isn't visible because the variable 1stHeight is zero. Using Option Explicit would have picked up the un-declared variable in your Dim statements. Set it to 1000 and you'll see the listbox!

I only provided a snippet of the Code. The lstHeight is set based on the amount of records that I get from an sql statement. Also declared is:

Dim obj As OLEObject
This is one of the ways I tried to delete the listbox


'Remove current listbox object
With objOLE
.Delete
End With


I can't select the listbox in Developer mode and it doesn't delete using the shapes delete method.Further it doesn't show up in the objects pane or with the object select.

Also, I really need vba code to delete it as this will be deleted and remade any time the code runs.

Here is the complete code:



Sub GetComponents(wsName As Worksheet, Analysis As Variant)
Dim Conn1 As New ADODB.Connection
Dim Cmd1 As New ADODB.Command
Dim Errs1 As Errors
Dim Rs1 As New ADODB.Recordset
Dim i As Integer
Dim AccessConnect As String
Dim x As String
Dim ORACLE_USER_NAME As String
Dim ORACLE_PASSWORD As String
Dim sql As String
Dim myPort As String
Dim myHost As String
Dim OracleSID As String
Dim SERVICE_NAME As String
Dim rcnt As Integer
Dim lstHeight As Integer
Dim objOLE As OLEObject, objListBox As msforms.ListBox
Dim obj As OLEObject
Dim Records As Variant

' Error Handling Variables
Dim errLoop As Error
Dim strTmp As String

With Conn1
.CursorLocation = adUseClient
End With

'Set Sheet1 RowHeight
wsName.Rows("1:1").RowHeight = 24

x = wsName.Range("C2")

ORACLE_USER_NAME = "xxxxxxxxxxxxxx"
ORACLE_PASSWORD = "xxxxxxxxxxxx"
myPort = "1521"
myHost = "xxxxxxxx"
OracleSID = "10.6.4.142"
SERVICE_NAME = "xxxxxxxxxxx"

'Connection String
AccessConnect = "Provider=OraOLEDB.Oracle;" & _
"Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(Host=" & myHost & ")(Port=1521))(CONNECT_DATA=" & _
" (SERVICE_NAME=" & SERVICE_NAME & ")));User ID=" & ORACLE_USER_NAME & ";Password=" & ORACLE_PASSWORD

On Error GoTo AdoError ' Full Error Handling which traverses Connection object

Conn1.ConnectionString = AccessConnect
Conn1.Open
Cmd1.ActiveConnection = Conn1

sql = ""
sql = sql & "SELECT DISTINCT LWPROD.COMPONENT.NAME"
sql = sql & " FROM LWPROD.COMPONENT"
sql = sql & " INNER JOIN lwprod.ANALYSIS ON COMPONENT.ANALYSIS = ANALYSIS.NAME"
sql = sql & " WHERE ANALYSIS.NAME = '" & Analysis & "'"
sql = sql & " ORDER BY 1"

Cmd1.CommandText = sql

Set Rs1 = Cmd1.Execute
'Rs1.CursorLocation = adUseServer
Rs1.MoveFirst
Do Until Rs1.EOF
rcnt = rcnt + 1
Rs1.MoveNext
Loop

rcnt = rcnt 'Rs1.RecordCount
lstHeight = rcnt * 17
Rs1.MoveFirst
wsName.Range("A1:A" & rcnt).CopyFromRecordset Rs1

'Remove current listbox object
With objOLE
.Delete
End With

Set objOLE = wsName.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=0, Top:=0, Width:=150, Height:=lstHeight)

' set some properties
With objOLE
' these are properties of the container OLEObject, not the Listbox itself
.Name = "lstComponents"
.ListFillRange = "A1:A9"

Set objListBox = .Object
' toggle visibility to ensure the control is clickable
.Visible = False
.Visible = True
End With
' now we can set the listbox-specific properties
With objListBox
.MultiSelect = fmMultiSelectMulti
.MatchEntry = fmMatchEntryComplete
End With

'Close Connections
Rs1.Close
Conn1.Close
Conn1.ConnectionString = ""

Done:
Set Rs1 = Nothing
Set Cmd1 = Nothing
Set Conn1 = Nothing

'Prompt
MsgBox " Data Returned "
Exit Sub

AdoError:
'i = 1
On Error Resume Next

' Enumerate Errors collection and display properties of
' each Error object (if Errors Collection is filled out)
Set Errs1 = Conn1.Errors
For Each errLoop In Errs1
With errLoop
strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":"
strTmp = strTmp & vbCrLf & " ADO Error # " & .Number
strTmp = strTmp & vbCrLf & " Description " & .Description
strTmp = strTmp & vbCrLf & " Source " & .Source
i = i + 1
End With
Next
End Sub


If there's a better way to add, fill and delete a list box I would gladly change my code to get this working.

Thanks,
Jeff

[paulked]

As you named it lstComponents try:



Sheet4.Shapes.Range(Array("lstComponents")).Delete

[jolivanes]

You have to let all sites know that you are cross posting and supply the hyperlink to the other site(s)
People are not amused if they work on your problem to help you and find out that there is another site that has a result.

[jrdnoland]

Sorry cross posted in Ozgrid https://www.ozgrid.com/forum/

[jrdnoland]

in another module I'm adding the lisbox. Trying to get the selected items is being a pain, I'm using this:



Dim ItemReq(10) As String
Dim lItem As Integer
Dim objOLE As OLEObject, objListBox As msforms.ListBox
Dim lstComponents As msforms.ListBox
Dim ashp As Shape
Dim a As Integer


For Each ashp In Sheet2.Shapes
If ashp.Name <> "lstComponents" Then
Else
For lItem = 0 To Sheet2.lstComponents.ListCount - 1
If Sheet2.lstComponents.Selected(lItem) Then
ItemReq(a) = Sheet2.lstComponents.List(lItem)
a = a + 1
End If
Next
Exit For
End If
Next ashp
a = a - 1



I get the error Method or data member not found.

How would I resolve this?

[paulked]

1. Did post #4 work?
2. You have, once again, only posted a snippet of your code. Are you expecting a correct first-time answer?
3. This is unrelated to the original post, you should start a new thread with reference to this thread.

[jrdnoland]

1. Did post #4 work?
2. You have, once again, only posted a snippet of your code. Are you expecting a correct first-time answer?
3. This is unrelated to the original post, you should start a new thread with reference to this thread.

actually, this ended up working:



Dim ashp As Shape
For Each ashp In ActiveSheet.Shapes
If ashp.Name = "lstComponents" Then
ashp.Delete
End If
Next ashp

[paulked]

Why loop when you can do it direct? A waste of time!

[jrdnoland]

.

[jrdnoland]

Why loop when you can do it direct? A waste of time!

I tried you suggestion and it worked! Thanks!

[paulked]

Save time, save money :thumb