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:
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:
Thank you very much for the hand.
Baha
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
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: