Excel Ghost Instance Issue while making SQL Query on a worksheet

Hi all,

I am trying to run an SQL query to the worksheet of the workbook opened. This is worth noting, that this code is being called multiple times. Suppose if I have around 100 items in a listview, any item I will check or uncheck, this query will be fired. I tried selecting the five items, and the following code ran five times, and the excel ghost instance appeared.

Private con as ADODB.Connection

Public Sub LoadDivisionData(bool As Boolean)
    
    Dim rs As ADODB.Recordset
    Dim counter As Long
    Dim query As String
    Dim colName1 As String
    Dim colName2 As String
    Dim value As String
    Dim items_prev As String
    Dim items_actual As String
    Dim val As String
    Dim indexOfVar As Integer
    
    
    colName1 = ConfigMod.Segment1
    colName2 = ConfigMod.Segment2
    
    'initialize con
    GetConnection

    Set rs = New ADODB.Recordset

    
    'load the variables with the existing listbox items
    items_prev = ""
    items_actual = ""
    
    For counter = frmassg.lvwDivision.ListItems.Count To 1 Step -1
        items_prev = items_prev & " or " & "'" & frmassg.lvwDivision.ListItems.Item(counter).Text & "'"
    Next counter
    
    con.Open
    
    query = "select distinct(" & colName2 & ") from [" & Constants.SEGMENTSHEET & "$] where ((" & _
                            ConfigMod.Query_Account & ") and (" & colName2 & " <> ''))"
    rs.Open query, con
        
    
    While Not (rs.EOF = True)
        value = rs(0).value
        val = " or " & "'" & value & "'"
        items_actual = items_actual & " or " & "'" & value & "'"
        indexOfVar = InStr(1, items_prev, val, vbTextCompare)
        
        If (indexOfVar > 0) Then
            'already there
        Else
            'not in the list
            frmassg.lvwDivision.ListItems.Add Text:=value
        End If

        rs.MoveNext
    Wend
    
    For counter = frmassg.lvwDivision.ListItems.Count To 1 Step -1
        value = frmassg.lvwDivision.ListItems.Item(counter).Text
        val = " or " & "'" & value & "'"
        indexOfVar = 0
        indexOfVar = InStr(1, items_actual, val, vbTextCompare)
        
        
        If (indexOfVar > 0) Then
            'already there
        Else
            'not in the list
            frmassg.lvwDivision.ListItems.Remove counter
        End If

        If Err.Number > 0 Then
            'item already there
            Err.Clear
        Else
        End If
        
    Next counter

    If (rs.State = 1) Then
        rs.Close
    End If
    
    If con.State = 1 Then
        con.Close
    End If
    Set rs = Nothing
End Sub

Public Sub GetConnection()
Dim conExcelString As String

    conExcelString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";" & _
                                "Extended Properties=""Excel 8.0;HDR=Yes;"";"
    
    If (con Is Nothing) Then
        Set con = New ADODB.Connection
        con.ConnectionString = conExcelString
        con.CursorLocation = adUseClient
    End If

End Sub

There is no problem in the logic. Every thing is working fine and I am not getting any error. The only problem is, that whenever I try to close my Excel, it takes around 2 minutes to be removed from the Processes list in the task manager. It is really annoying me now. Can someone pleaseeee help?

I DON'T want to write any code in Workbook.close method.

Any idea?

Thanks,
Vikas