Using Select Case in sql code while extracting data through ADO from sql server

baha17

Board Regular
Joined
May 12, 2010
Messages
183
Dear Board Masters,

I have been trying to learn the way to extract data from sql server to excel by using VBA (ADO procedures). I managed to write several codes to extract data then add additional code to convert some of those data using for next statements. However while dealing over 100,000 rows, the code runs slow 10 to 15 minutes sometimes. I am thinking there should be better way to extract those data by using "case" function inside the sql code. I am not very familar using that inside the sql code for excel VBA. As you can see in my code I am replacing some of those data by using vlookup worksheet function. How can I alter that code by using "case" function? Just to give a quick example; if I want to wite that for simple excel VBA code it would be similiar to this:
Code:
Dim ShopName
Select Case ShopName
Case Is = "Sh 1", "Sh 2", "Sh 3", "Sh 4"
ShopName = "MGF"
Case Is = "Sh 31", "Sh 21", "Sh 41"
ShopName = "HL"
Case Is = "Sh 51", "Sh 61", "Sh 71"
ShopName = "Premium"
End Select
I beleive you get my logic here. I am just trying to replace "setup_Market.shop_name" with above data, ShopName is representing "setup_Market.shop_name"). Here is my code so far:
Code:
Sub MarketRatings()
Dim DBFullName, TableName As String
Dim TargetRange As Range
Dim Conn As ADODB.Connection, intColIndex As Integer
Dim cel As Range
Dim TD As Long
Dim qdate As Double
Dim qdate2 As Double
Dim LastRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
LastRow = Sheets("CustomerData").Range("A" & Sheets("CustomerData").Rows.Count).End(xlUp).Row
'On Error Resume Next
qdate = Range("trddate").Value
qdate2 = Range("trddate2").Value
    
    Sheets("CustomerData").Range("AA:AZ").ClearContents
    Sheets("CustomerData").Range("A2:T" & LastRow + 2).ClearContents
    Sheets("CustomerData").Select
    Columns("A:R").AutoFilter
    Range("A2").Select
    Selection.Activate
    Set TargetRange = Range("A2")
    Set Conn = New ADODB.Connection
     Conn.Open "driver={SQL Server};" & _
    "server=yba002;database=MarketSales;"
        Set RecSet = New Recordset
    RecSet.Open "SELECT  custmast.cust_id,  custmast.lname + ' ' + custmast.fname, custmast.lname, custmast.lname,  inhouse.counter_id, inhouse.sale_date, " & _
    "inhouse.empl_id,  " & _
    "inhouse.dealer_id, " & _
    "replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(inhouse.counter_id,'0',''),'1',''),'2',''),'3',''),'4',''),'5',''),'6',''),'7',''),'8',''),'9',''), " & _
    "inhouse.time_in, inhouse.time_out, " & _
    "inhouse.hours, inhouse.totalin, inhouse.estwl, inhouse.avgbet, inhouse.maxbet, '', " & _
    "setup_Market.shop_name " & _
    "FROM MarketSales.dbo.custmast custmast WITH (nolock), MarketSales.dbo.sales sales WITH (nolock), MarketSales.dbo.inhouse inhouse WITH (nolock), MarketSales.dbo.setup_Market setup_Market WITH (nolock) " & _
    "WHERE inhouse.card_id = custmast.card_id AND  inhouse.counter_id = setup_Market.counter_id AND " & _
    "sales.sale_type = setup_Market.sale_type AND inhouse.counter_id = setup_Market.counter_id AND setup_Market.shop_id <>'" & 99 & "' AND " & _
    "inhouse.sale_date>='" & qdate & "'And inhouse.sale_date<='" & qdate2 & "' ORDER BY setup_Market.shop_name", Conn, , , adCmdText
    TargetRange.CopyFromRecordset RecSet
    RecSet.Close
    Set RecSet = Nothing
    Conn.Close
    Set Conn = Nothing
LastRow = Sheets("CustomerData").Range("B" & Sheets("CustomerWinLoss").Rows.Count).End(xlUp).Row + 1
Select Case Sheets("Main").Range("J2")
Case Is <> ""
For Each cel In Sheets("CustomerData").Range("A2:A" & LastRow)
With Sheets("CustomerData")
If cel <> "" Then
cel.Offset(0, 16).Formula = "=SumProduct(--(A2:A" & LastRow & "=" & cel.Address & _
    "),--(F2:F" & LastRow & "=" & cel.Offset(0, 5).Address & "),N2:N" & LastRow & ")"
cel.Offset(0, 18) = Application.WorksheetFunction.VLookup(cel.Offset(0, 17).Value, Sheets("CustomerData").Range("SandsShops"), 2, 0)
cel.Offset(0, 19) = Application.WorksheetFunction.VLookup(cel.Offset(0, 17).Value, Sheets("CustomerData").Range("SandsGroup"), 2, 0)
End If
End With
Next cel
Case Else
For Each cel In Sheets("CustomerData").Range("A2:A" & LastRow)
With Sheets("CustomerData")
If cel <> "" Then
cel.Offset(0, 18) = Application.WorksheetFunction.VLookup(cel.Offset(0, 17).Value, Sheets("CustomerData").Range("SandsShops"), 2, 0)
cel.Offset(0, 19) = Application.WorksheetFunction.VLookup(cel.Offset(0, 17).Value, Sheets("CustomerData").Range("SandsGroup"), 2, 0)
End If
End With
Next cel
End Select
    Columns("L:L").NumberFormat = "0.00"
    Columns("J:K").NumberFormat = "h:mm;@"
    Columns("I:I").NumberFormat = "m/d/yyyy"
Columns("A:R").AutoFilter
    Sheets("CustomerData").Select
    Columns("A:B").Select
    Selection.Copy
    Range("AA1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Q:Q").Select
    Selection.Copy
    Range("AC1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    LastRow = Sheets("CustomerData").Range("AA" & Sheets("CustomerData").Rows.Count).End(xlUp).Row
    ActiveSheet.Range("AA2:AC" & LastRow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:= _
        xlYes
    Range("A1").Select
    
LastRow = Sheets("CustomerData").Range("A" & Sheets("CustomerData").Rows.Count).End(xlUp).Row
'Filtering
Sheets("Main").Select
Range("HeadCount") = Application.WorksheetFunction.CountA(Sheets("CustomerData").Range("AA:AA"))

End Sub

Thank you very much for the hand.
Baha
 
Last edited:

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
First of all, using hints in sql query is not the best idea (WITH (nolock)).
Second, the speed of retrieval depends on many factors. One of them is presence of indexes. The theme of indexes is vast enough (there're whole books about indexes), so there's no "right-now-and-correct" answer.
Third, I'd advise to encapsulate all logic into stored procedure, which makes your VBA code much cleaner.
 
Upvote 0
Hi Sektor,
I am not very familiar with usage of sql function in the vba code. That's why I was thinking maybe I could use "case" function to run my data. All i want is if the "Market.shop_name" is as below,it displays different text for me. The reason I am doing is there are 99 shops and it would be easier to filter if I can drop it down to 4-5 kind of shops rather than shop name.The logic should be similiar to
Code:
Select Case ShopName
Case Is = "Sh 1", "Sh 2", "Sh 3", "Sh 4"
ShopName = "MGF"
Case Is = "Sh 31", "Sh 21", "Sh 41"
ShopName = "HL"
Case Is = "Sh 51", "Sh 61", "Sh 71"
ShopName = "Premium"
But I don't know how can I use that like a sql funtion in my code.
However, if you suggest me another way I would like to try aswell.
Cheers
Baha
 
Upvote 0
What do you mean "sql function in the <acronym title="visual basic for applications">vba</acronym> code"? There's absolutely no connection between these guys. I offer to encapsulate your logic into stored procedure.
 
Upvote 0
The problem, IMO, is not a case statement but the fact that you are looping through all the rows containing data, one row at a time adding an Excel formula. BTW, what is the intent behind the SUMPRODUCT? From what I can tell column A will have customer IDs and you are comparing them with cell.address?

In any case, assuming SandsShops and SandsGroup exist in the worksheet but not in the SQL database, you should look into working with entire ranges at a time rather than one row at a time. For an intro see Beyond Excel's recorder particularly example 4.

The equivalent of VBA Case in SQL is Case! Look it up in google/bing -- a direct link is SQL Server: CASE WHEN OR THEN ELSE END => the OR is not supported - Stack Overflow


Hi Sektor,
I am not very familiar with usage of sql function in the vba code. That's why I was thinking maybe I could use "case" function to run my data. All i want is if the "Market.shop_name" is as below,it displays different text for me. The reason I am doing is there are 99 shops and it would be easier to filter if I can drop it down to 4-5 kind of shops rather than shop name.The logic should be similiar to
Code:
Select Case ShopName
Case Is = "Sh 1", "Sh 2", "Sh 3", "Sh 4"
ShopName = "MGF"
Case Is = "Sh 31", "Sh 21", "Sh 41"
ShopName = "HL"
Case Is = "Sh 51", "Sh 61", "Sh 71"
ShopName = "Premium"
But I don't know how can I use that like a sql funtion in my code.
However, if you suggest me another way I would like to try aswell.
Cheers
Baha
 
Upvote 0
Hi Tusharm,

Thank you very much. I check that out and adopted to my code. It partly work. Because once I use for only 11 shops there is no problem. But if I put more than 11 lines it says "too many line continnations". I still have another 30 shops to set it up. I tried using "," instead of each line did not work. I mean Instead of
Code:
 "WHEN 'Sh 1' THEN 'MGF' " & _
    "WHEN 'Sh 2' THEN 'MGF' " & _
    "WHEN 'Sh 3' THEN 'MGF' " & _
I tried to use
Code:
 "WHEN 'Sh 1' , 'Sh 2' , 'Sh 3' THEN 'MGF' " & _
. But did not work.Any better way?

Here is my final code:
Code:
Sub MarketRatings()
Dim DBFullName, TableName As String
Dim TargetRange As Range
Dim Conn As ADODB.Connection, intColIndex As Integer
Dim cel As Range
Dim TD As Long
Dim qdate As Double
Dim qdate2 As Double
Dim LastRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
LastRow = Sheets("CustomerData").Range("A" & Sheets("CustomerData").Rows.Count).END(xlUp).Row
'On Error Resume Next
qdate = Range("trddate").Value
qdate2 = Range("trddate2").Value
    
    Sheets("CustomerData").Range("AA:AZ").ClearContents
    Sheets("CustomerData").Range("A2:T" & LastRow + 2).ClearContents
    Sheets("CustomerData").Select
    Columns("A:R").AutoFilter
    Range("A2").Select
    Selection.Activate
    Set TargetRange = Range("A2")
    Set Conn = New ADODB.Connection
     Conn.Open "driver={SQL Server};" & _
    "server=yba002;database=MarketSales;"
        Set RecSet = New Recordset
    RecSet.Open "SELECT  custmast.cust_id,  custmast.lname + ' ' + custmast.fname, custmast.lname, custmast.lname,  inhouse.counter_id, inhouse.sale_date, " & _
    "inhouse.empl_id,  " & _
    "inhouse.dealer_id, " & _
    "replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(inhouse.counter_id,'0',''),'1',''),'2',''),'3',''),'4',''),'5',''),'6',''),'7',''),'8',''),'9',''), " & _
    "inhouse.time_in, inhouse.time_out, " & _
    "inhouse.hours, inhouse.totalin, inhouse.estwl, inhouse.avgbet, inhouse.maxbet, '', " & _
    "CASE setup_Market.shop_name " & _
    "WHEN 'Sh 1' THEN 'MGF' " & _
    "WHEN 'Sh 2' THEN 'MGF' " & _
    "WHEN 'Sh 3' THEN 'MGF' " & _
    "WHEN 'Sh 4' THEN 'MGF' " & _
    "WHEN 'Sh 5' THEN 'PRE' " & _
    "WHEN 'Sh 6' THEN 'PRE' " & _
    "WHEN 'Sh 7' THEN 'MGF' " & _
    "WHEN 'Sh 8' THEN 'PRE' " & _
    "WHEN 'Sh 9' THEN 'PRE' " & _
    "WHEN 'Sh 12' THEN 'HL' " & _
    "WHEN 'Sh 15' THEN 'HL' " & _
    "Else 'NON MGF' " & _
    "END " & _
    "FROM MarketSales.dbo.custmast custmast WITH (nolock), MarketSales.dbo.sales sales WITH (nolock), MarketSales.dbo.inhouse inhouse WITH (nolock), MarketSales.dbo.setup_Market setup_Market WITH (nolock) " & _
    "WHERE inhouse.card_id = custmast.card_id AND  inhouse.counter_id = setup_Market.counter_id AND " & _
    "sales.sale_type = setup_Market.sale_type AND inhouse.counter_id = setup_Market.counter_id AND setup_Market.shop_id <>'" & 99 & "' AND " & _
    "inhouse.sale_date>='" & qdate & "'And inhouse.sale_date<='" & qdate2 & "' ORDER BY setup_Market.shop_name", Conn, , , adCmdText
    TargetRange.CopyFromRecordset RecSet
    RecSet.Close
    Set RecSet = Nothing
    Conn.Close
    Set Conn = Nothing
LastRow = Sheets("CustomerData").Range("B" & Sheets("CustomerWinLoss").Rows.Count).END(xlUp).Row + 1
Sheets("Main").Select
Range("HeadCount") = Application.WorksheetFunction.CountA(Sheets("CustomerData").Range("AA:AA"))
End Sub
 
Upvote 0
Just in case someone is going through the same progress, I fix this problem mainly adopting my code with above suggestion from tursham. I also get rid of those "continnations"
Code:
"WHEN 'Sh 1' THEN 'MGF' WHEN 'Sh 2' THEN 'MGF' WHEN 'Sh 3' THEN 'MGF' WHEN 'Sh 4' THEN 'MGF' WHEN 'Sh 5' THEN 'MGF' " & _
and so on....
Thank you very much both of you for your inputs...
Cheers
 
Upvote 0

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

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