Dear Masters,
I wrote a code which allows me extract data from server for the sales in my company. If I run it for one month period it takes very long time. Actually I realised it is nothing to the with the server, it slows down because it involves other vba command to format the cells. Since it gets over 100K rows it slows down. Is there anyway to replace those command in the sql statement cuch as below? Thanks for the helpw
Baha
and
Here is my whole code:
I wrote a code which allows me extract data from server for the sales in my company. If I run it for one month period it takes very long time. Actually I realised it is nothing to the with the server, it slows down because it involves other vba command to format the cells. Since it gets over 100K rows it slows down. Is there anyway to replace those command in the sql statement cuch as below? Thanks for the helpw
Baha
Code:
Sheets("CustomerData").Range("A2:A" & LastRow).Replace What:="V2", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=Falseand
Code:
For Each cel In Sheets("CustomerData").Range("A2:A" & LastRow)
If cel.Text <> "" Then
cel.Offset(0, 1) = cel.Offset(0, 3).Text & " " & cel.Offset(0, 2).Text
cel.Offset(0, 16) = _
Application.WorksheetFunction.SumIf(Sheets("CustomerData").Range("A2:A" & LastRow), cel.Value, Sheets("CustomerData").Range("N2:N" & LastRow))
End If
Next celHere is my whole code:
Code:
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 'sales.stat_date
Range("A2").Select
Selection.Activate
Set TargetRange = Range("A2")
Set Conn = New ADODB.Connection
Conn.Open "driver={SQL Server};" & _
"server=AACTM12;database=SalesDataBase;"
Set RecSet = New Recordset
RecSet.Open "SELECT sales.card_id, '', custmast.fname, custmast.lname, sales.table_id, sales.game_date, " & _
"sales.empl_id, " & _
"sales.dealer_id, '', sales.time_in, sales.time_out, " & _
"sales.hours, sales.totalin, sales.estwl, sales.avgbet, sales.maxbet, '', " & _
"setup_casino.pit_name " & _
"FROM SalesDataBase.dbo.custmast custmast, SalesDataBase.dbo.sales sales, SalesDataBase.dbo.setup_casino setup_casino " & _
"WHERE sales.card_id = custmast.card_id AND sales.table_id = setup_casino.table_id AND " & _
"sales.game_date>='" & qdate & "'And sales.game_date<='" & qdate2 & "'", Conn, , , adCmdText
TargetRange.CopyFromRecordset RecSet
RecSet.Close
Set RecSet = Nothing
Conn.Close
Set Conn = Nothing
LastRow = Sheets("CustomerData").Range("A" & Sheets("CustomerData").Rows.Count).End(xlUp).Row
Sheets("CustomerData").Range("A2:A" & LastRow).Replace What:="V2", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
For Each cel In Sheets("CustomerData").Range("A2:A" & LastRow)
If cel.Text <> "" Then
cel.Offset(0, 1) = cel.Offset(0, 3).Text & " " & cel.Offset(0, 2).Text
cel.Offset(0, 16) = _
Application.WorksheetFunction.SumIf(Sheets("CustomerData").Range("A2:A" & LastRow), cel.Value, Sheets("CustomerData").Range("N2:N" & LastRow))
End If
Next cel
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("TableData").Rows.Count).End(xlUp).Row
For Each cel In Sheets("CustomerData").Range("E2:E" & LastRow)
If cel.Text <> "" Then
cel.Offset(0, 4) = SaleType(cel.Text)
End If
Next cel
Sheets("Main").Select
End Sub
Function SaleType(text_string As String)
If IsNumeric(Mid(text_string, 3, 1)) Then
SaleType = Left(text_string, 2)
Else
SaleType = Left(text_string, 3)
End If
End Function
, though maybe not as resilient
