Issue with Multiple selection in listbox as a criteria to extract data from sql server to excel.

[abhay_547]

Hi All,

I have the below macro which I have recorded for importing the data from SQL Server table. I have a userform in which I have list box I am populating that listbox with some values from another sql server table. Now what I am doing is, while importing the data from sql table I select a criteria now I want the user to select multiple items in listbox and my below macro should consider that selection and extract the data accordingly. As of now below mentioned code works fine with single selection in listbox but when I select multiple items in my listbox. It shows error. Please help.

Sub sqldataextract()
Dim Product As String
Dim CostElement As String
CostElement = frmwarehouse.TextBox1.Value
[B]Product = frmwarehouse.ListBox4.Value[/B]
    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DRIVER=SQL Native Client;SERVER=XXXXXXXXX;UID=admin;PWD=*****;APP=Microsoft Office XP;WSID=XXXXXXXX" _
        ), Array(";DATABASE=meta_data;")), Destination:=Range("A1"))
        .CommandText = Array( _
        "SELECT mydata.CAC, mydata.Year, mydata.""Cost Element"", mydata.""Cost Element Name"", mydata.Name, mydata.""Cost Center"", mydata.""Company Code"", mydata.""Unique Indentifier 1"", ""Cost Center mapping"".""Produ" _
        , _
        "ct UBR Code"", ""Cost Element Mapping"".FSI_LINE2_code" & Chr(13) & "" & Chr(10) & "FROM sap_data.dbo.""Cost Center mapping"" ""Cost Center mapping"", sap_data.dbo.""Cost Element Mapping"" ""Cost Element Mapping"", sap_data.dbo.mydata myda" _
        , _
        "ta" & Chr(13) & "" & Chr(10) & "WHERE mydata.""Unique Indentifier 1"" = ""Cost Element Mapping"".CE_SR_NO AND mydata.""Cost Center"" = ""Cost Center mapping"".""Cost Center"" AND ((""Cost Center mapping"".[B]""Product UBR Code""='" & Product & "'[/B]) AND (""" _
        , "Cost Element Mapping"".FSI_LINE2_code='" & CostElement & "'))")
        .Name = "Query from mydatanew"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Currently my listbox's MultiSelect property is set to 0. If I set it to 1 or 2 the above macro doesn't work.

Please have a look at the attached screenshot. This will help you to understand my issue in better way.

Thanks for your help in advance.

 

[doofusboy]

My guess is you're going to need to do one of these:

""Cost Center mapping"".""Product UBR Code""='" & Product & "'

for each item selected in the listbox.

Or maybe do a completely separate query for each item selected from the listbox since I'm not familiar with your data. In otherwords, put the whole With ActiveSheet.QueryTables.Add in a For loop that executes for each item selected in the listbox.

 

[abhay_547]

Hi doofusboy,

Thanks a lot for your reply. erroneously i had mentioned in below code line incorrectly.

Incorrect :

"Product UBR Code""='" & Product & "'

Correct :

"Sub Product UBR Code""='" & Product & "'

However, I liked the second option suggested by you in the below post. Is it possible for your provide me with the example of the same. I have attached my sql data table extract for better understanding.

 

[abhay_547]

Please ignore the earlier post and consider this one.

Hi doofusboy,

Thanks a lot for your reply. erroneously i had mentioned in below code line incorrectly.

Incorrect :

"Product UBR Code""='" & Product & "'

Correct :

"Sub Product UBR Code""='" & Product & "'

However, I liked the second option suggested by you in the below post. Is it possible for your provide me with the example of the same. Just to clarify I have a column called "Sub Product UBR Code" in my sql table .i.e Cost Center Mapping. My listbox gets populated with "Sub Product UBR Codes" Now apart from this I have one more sql table which is named as "mydata" which contains a column called "Cost Center" which is also present in cost center mapping table and is used as a base for mapping .i.e a relationship is built as using below code line in both tables.

 mydata.""Cost Center"" = ""Cost Center mapping"".""Cost Center""

As of now I am able to extract the data using the above code by selecting only one "Sub Product UBR Code" in the listbox but when I select multiple "Sub Product UBR codes" in my listbox it doesn't work. Please help...

Thanks for your help in advance.

 

[abhay_547]

Hi,

Did anyone get the chance to look at the above post. Please help...

 

[abhay_547]

Hi All,

I have got the below code from an extensive google search which I think can help us in selecting the listbox items as a parameter / criteria in the query macro posted by me in the above thread.

Code 1 :

Dim frm As Form
Dim ctl As Control
Dim varItem As Variant
Dim strSQL As String
Dim strWhere As String

For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ", "
Next varItem


For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
Next

lngLen = Len(strWhere)
If lngLen <> 0 Then 'There was at least one item selected
strWhere = "WHERE [Sub Product UBR Code] IN (" & _
Left(strWhere, lngLen-1) & ")"
Else 'No items selected - no filter
Do Nothing
End If

strSQL = strSQL & strWhere
'!End Code Fragment!**************

'Note : this assumes your listbox is returning numeric values. If it returns
'text you'll have to concatenate in some quotes to delimit them.[/vba]
Can anyone help me to replicate the above code in the my query so that I can select multiple items in listbox and my query would extract data from sql table on the basis of my selected items in listbox.

Code 2 :

For Each i In Me!
[List0].ItemsSelected 
    If Criteria <> "" Then 
        Criteria = Criteria & " OR " 
    End If 
    Criteria = Criteria & Me!
[List0].ItemData(i) & "= True" 
Next i

Code 3 :

Public Function 
    Public Function fMultiSelect(ctlRef As ListBox) As Variant 
        Dim Criteria As String 
        Dim i As Variant 
         
         ' Build criteria string from selected items in list box.
        Criteria = "" 
        For Each i In ctlRef.ItemsSelected 
            If Criteria <> "" Then 
                Criteria = Criteria & "," 
            End If 
            Criteria = Criteria & Format(ctlRef.ItemData(i), "0000000") 
        Next i 
         
        fMultiSelect = Criteria 
        gMultiSelect = Criteria 
    End Function 
     
Call: 
    Call fMultiSelect(Forms!frmPreSPIPComp!lstProjects)

Code 4 :

'******************** Code Start ************************
Dim frm As Form, ctl As Control 
Dim varItem As Variant 
Dim strSQL As String 
Set frm = Form!frmMyForm 
Set ctl = frm!lbMultiSelectListbox 
strSQL = "Select * from [Cost Center Mapping] where [Sub Product UBR Code]=" 
 'Assuming long [Sub Product UBR Code] is the bound field in lb
 'enumerate selected items and
 'concatenate to strSQL
For Each varItem In ctl.ItemsSelected 
    strSQL = strSQL & ctl.ItemData(varItem) & " OR [Sub Product UBR Code]=" 
Next varItem 
 
 'Trim the end of strSQL
strSQL=left$(strSQL,len(strSQL)-12)) 
 '******************** Code end ************************

Code 5 :

Private Sub Command7_Click() 
    Me.Filter = "COMPANYnumber " & GetInClause(Me!lstCustomer) 
     
     ' Turn on the form's  filter.
    Me.FilterOn = True 
End Sub 
 
Function GetInClause(lst As  ListBox) As String 
     ' Build up the In() clause for a multi-select
     ' list box. If the list box isn't multi-select
     ' return "Like '*'".
     
    Dim strOut As String 
    Dim varItem As Variant 
     
     ' Single select is 0, Simple multi-select is 1,
     ' and extended multi-select is 2.
    If lst.MultiSelect > 0 Then 
         '  Loop through all the elements
         ' of the ItemsSelected collection, and use
         ' the ItemData  array to retrieve the
         ' associated bound value.
        If lst.ItemsSelected.Count > 0 Then 
            For Each varItem In lst.ItemsSelected 
                strOut = strOut & ", " & lst.ItemData(varItem) 
            Next varItem 
             ' Strip off the leading ", ".
            strOut = Mid(strOut, 3) 
             ' Build up the output string.
            strOut = "In(" & strOut & ")" 
        Else 
             ' If no rows selected, simply
             ' use all the rows.
            strOut = "Like '*'" 
        End If 
    Else 
         ' If the list box isn't multiselect,
         ' then return the Customer ID for the
         ' selected row.
        strOut = " = " & lst.ItemData(lst.ListIndex) 
    End If 
    GetInClause = strOut 
End Function

Thanks a lot for your help in advance.

 

[Norie]

I think that latest code is for Access not Excel or SQL Server,

The first thing you should do is find out what the SQL would be for a query with multiple criteria.

Once you've got that you can start on constructing the appropriate SQL statement.

 

[abhay_547]

Hi Norie,

Thanks a lot for your reply and I agree that few of the codes which I have posted (Got from google search) are of MS Access but not all of them there are few codes which are for excel. However Why I had posted all this codes because I thought that it will help you guys to help me with some code to my existing macro as I am unable to construct anything from my end on the basis of the same. Please help.


Thanks for your help in advance.

 

[Norie]

I'm not familiar with SQL Server so I don't know how exactly it deals with multiple criteria.

You could probably use multiple ORs but that would probably be impractical.

Access does have the In operator but I don't know if SQL Server supports that.

That's why I suggested you try and find out what the SQL statement would be in SQL Server for this sort of query.

 

[abhay_547]

Hi All,

Thanks a lot for your reply. Please find the below code which I have got through a extensive google search. Can we use any part of the below code in some way in my main macro.

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim i As Integer

Dim strSQL As String
Dim strIN As String
Dim strWhere As String

Set db = CurrentDb
strSQL = "SELECT
Skills_Interests.ROTAID,Skills_Interests.Skills_Interests_Preference1 FROM
Skills_Interests "


For i = 0 To lstSkillsInterests.ListCount - 1
   If lstSkillsInterests.Selected(i) Then
       strIN = strIN & "'" & lstSkillsInterests.Column(0, i) & "', "
   End If
Next i

strWhere = "Where Skills_Interests.Skills_Interests_Preference1 IN( " &
Left(strIN, Len(strIN) - 1) & ")"

strSQL = strSQL & strWhere

'MsgBox strSQL

'*** delete the previous query
db.QueryDefs.Delete "SIP1"
Set qdf = db.CreateQueryDef("SIP1", strSQL)

Apart from the above code I got the below links which contains some info.

http://support.microsoft.com/kb/100131/en-us

http://www.tech-archive.net/Archive/Access/microsoft.public.access.queries/2009-04/msg00299.html


Thanks a lot for your help in advance.