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 <> “” Then
strSQL = strSQL & ” [Vehicle Model]='” & cboVehicleModel.Text & “‘”
End If
If cboRegion.Text <> “” Then
If cboVehicleModel.Text <> “” Then
strSQL = strSQL & ” AND [Region]='” & cboRegion.Text & “‘”
Else
strSQL = strSQL & ” [Region]='” & cboRegion.Text & “‘”
End If
End If
If cboCustomerType.Text <> “” Then
If cboVehicleModel.Text <> “” Or cboRegion.Text <> “” Then
strSQL = strSQL & ” AND [Customer Type]='” & cboCustomerType.Text & “‘”
Else
strSQL = strSQL & ” [Customer Type]='” & cboCustomerType.Text & “‘”
End If
End If
If cboVehicleModel.Text <> “” Or cboRegion.Text <> “” Or cboCustomerType.Text <> “” Then
‘now extract data
closeRS
OpenDB myrs.Open strSQL, conn, adOpenKeyset, adLockOptimistic If myrs.RecordCount > 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 <> "" And cboRegion.Text <> "" And cboCustomerType.Text <> "" 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 > 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 > 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 > 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 > 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