Advertisement

Using Activex Controls SQL VBA to Analyze Excel Data

Using Activex Controls SQL VBA to Analyze Excel Data How to use activex controls like combo-boxes and command buttons, SQL and VBA to analyze Excel worksheet data super fast automatically.
Here's the complete VBA code:
Option Explicit
Public conn As New ADODB.Connection
Public myrs As New ADODB.Recordset
Public strSQL As String

Public Sub OpenDB()
If conn.State = adStateOpen Then conn.Close
conn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
conn.Open
End Sub

Public Sub closeRS()
If myrs.State = adStateOpen Then myrs.Close
myrs.CursorLocation = adUseClient
End Sub

Option Explicit

Private Sub cmdClear_Click()
'clear the data
cboVehicleModel.Clear
cboRegion.Clear
cboCustomerType.Clear
Sheet2.Visible = True
Sheet2.Select
Range("dataset").Select
Range(Selection, Selection.End(xlDown)).ClearContents
End Sub
Private Sub cmdDisplayData_Click()
'populate data
strSQL = "SELECT * FROM [Sheet1$] WHERE "
If cboVehicleModel.Text Not Equal To "" Then
strSQL = strSQL & " [Vehicle Model]='" & cboVehicleModel.Text & "'"
End If
If cboRegion.Text Not Equal To "" Then
If cboVehicleModel.Text Not Equal To "" Then
strSQL = strSQL & " AND [Region]='" & cboRegion.Text & "'"
Else
strSQL = strSQL & " [Region]='" & cboRegion.Text & "'"
End If
End If
If cboCustomerType.Text Not Equal To "" Then
If cboVehicleModel.Text Not Equal To "" Or cboRegion.Text Not Equal To "" Then
strSQL = strSQL & " AND [Customer Type]='" & cboCustomerType.Text & "'"
Else
strSQL = strSQL & " [Customer Type]='" & cboCustomerType.Text & "'"
End If
End If
If cboVehicleModel.Text Not Equal To "" Or cboRegion.Text Not Equal To "" Or cboCustomerType.Text Not Equal To "" Then
'now extract data
closeRS

OpenDB
myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
If myrs.RecordCount Greater Than 0 Then
Sheet2.Visible = True
Sheet2.Select
Range("dataset").Select
Range(Selection, Selection.End(xlDown)).ClearContents
'Now putting the data on the sheet
ActiveCell.CopyFromRecordset myrs
Else
MsgBox "No matching records found!", vbExclamation + vbOKOnly
Exit Sub
End If
'getting the total revenue using Query
If cboVehicleModel.Text Not Equal To "" And cboRegion.Text Not Equal To "" And cboCustomerType.Text Not Equal To "" Then
strSQL = "SELECT SUM ([Sheet1$].[Cost]) FROM [Sheet1$] WHERE ((([Sheet1$].[Vehicle Model]) = '" & cboVehicleModel.Text & "' ) And " & _
" (([Sheet1$].[Region]) = '" & cboRegion.Text & "' ) And (([Sheet1$].[Customer Type]) = '" & cboCustomerType.Text & "' )); "
closeRS
OpenDB

myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
If myrs.RecordCount Greater Than 0 Then
Range("I6").CopyFromRecordset myrs
MsgBox "The total revenues from " & cboVehicleModel.Text & " in " & cboRegion.Text & " from " & cboCustomerType.Text & " were " & Range("I6").Value, vbExclamation + vbOKOnly
Else
Range("I6").Clear
MsgBox "The total revenue could not be retrieved!", vbExclamation + vbOKOnly
Exit Sub
End If
End If
End If
End Sub
Private Sub cmdUpdate_Click()
strSQL = "Select Distinct [Vehicle Model] From [Sheet1$] Order by [Vehicle Model]"
closeRS
OpenDB
cboVehicleModel.Clear
myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
If myrs.RecordCount Greater Than 0 Then
Do While Not myrs.EOF
cboVehicleModel.AddItem myrs.Fields.Item("Vehicle Model")
myrs.MoveNext
Loop
Else
MsgBox "No unique vehicle models found!", vbCritical + vbOKOnly
Exit Sub
End If
strSQL = "Select Distinct [Region] From [Sheet1$] Order by [Region]"
closeRS
OpenDB
cboRegion.Clear
myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
If myrs.RecordCount Greater Than 0 Then
Do While Not myrs.EOF
cboRegion.AddItem myrs.Fields.Item("Region")
myrs.MoveNext
Loop
Else
MsgBox "No unique regions found!", vbCritical + vbOKOnly
Exit Sub
End If
strSQL = "Select Distinct [Customer Type] From [Sheet1$] Order by [Customer Type]"
closeRS
OpenDB
cboCustomerType.Clear
myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
If myrs.RecordCount Greater Than 0 Then
Do While Not myrs.EOF
cboCustomerType.AddItem myrs.Fields.Item("Customer Type")
myrs.MoveNext
Loop
Else
MsgBox "No unique customer types found!", vbCritical + vbOKOnly
Exit Sub
End If
End Sub

Using Activex Controls SQL VBA to Analyze Excel Data,Using Activex Controls SQL VBA to Analyze Excel Data automatically,Using Activex Controls SQL VBA to Analyze Excel Data automatically super fast,

Post a Comment

0 Comments