Covert SQL Code to VBA

Hi All

I have downloaded attached workbook from a web side and the code used in this work is in SQL , which are difficult for me to understand I want to know that if attached workbook code can be converted to VBA.

Thanks in advance

This is only for copying the results, not for filling the CB's.
If you want that changed to VBA also, just ask.
Also change the range of dataset to "B12:K12"

Code:

---

Private Sub cmdShowData_Click()

    Dim rngTarget As Range, i As Integer
    Application.ScreenUpdating = False
    Sheets("View").Range("dataSet").CurrentRegion.Offset(1).ClearContents
    With Worksheets("data")
        Set rngTarget = .Range("A1:J" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With rngTarget
            For i = 1 To 3
                .AutoFilter i + 2, Choose(i, cmbProducts.Text, cmbRegion.Text, cmbCustomerType.Text)
            Next
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("B13")
            .AutoFilter
        End With
    End With
    Application.ScreenUpdating = True

End Sub

---

Thanks bakerman for your reply but you have converted only one macro of attached workbook there are more macros/code in attached workbook

Code:

---

Private Sub cmdReset_Click()
    'clear the data
    cmbProducts.Clear
    cmbCustomerType.Clear
    cmbRegion.Clear
    Sheets("View").Visible = True
    Sheets("View").Select
    Range("dataSet").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
End Sub

Private Sub cmdShowData_Click()
    'populate data
    strSQL = "SELECT * FROM [data$] WHERE "
    If cmbProducts.Text <> "" Then
        strSQL = strSQL & " [Product]='" & cmbProducts.Text & "'"
    End If
   
    If cmbRegion.Text <> "" Then
        If cmbProducts.Text <> "" Then
            strSQL = strSQL & " AND [Region]='" & cmbRegion.Text & "'"
        Else
            strSQL = strSQL & " [Region]='" & cmbRegion.Text & "'"
        End If
    End If

    If cmbCustomerType.Text <> "" Then
        If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Then
            strSQL = strSQL & " AND [Customer Type]='" & cmbCustomerType.Text & "'"
        Else
            strSQL = strSQL & " [Customer Type]='" & cmbCustomerType.Text & "'"
        End If
    End If
   
    If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Or cmbCustomerType.Text <> "" Then
        'now extract data
        closeRS
       
        OpenDB
       
        rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.RecordCount > 0 Then
            Sheets("View").Visible = True
            Sheets("View").Select
            Range("dataSet").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
           
            'Now putting the data on the sheet
            ActiveCell.CopyFromRecordset rs
        Else
            MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
            Exit Sub
        End If

        'Now getting the totals using Query
        If cmbProducts.Text <> "" And cmbRegion.Text <> "" And cmbCustomerType.Text <> "" Then
            strSQL = "SELECT Count([data$].[Call ID]) AS [CountOfCall ID], [data$].[Resolved] " & _
            " FROM [Data$] WHERE ((([Data$].[Product]) = '" & cmbProducts.Text & "' ) And " & _
            " (([Data$].[Region]) =  '" & cmbRegion.Text & "' ) And (([Data$].[Customer Type]) =  '" & cmbCustomerType.Text & "' )) " & _
            " GROUP BY [data$].[Resolved];"
           
            closeRS
            OpenDB
           
            rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
            If rs.RecordCount > 0 Then
                Range("L6").CopyFromRecordset rs
            Else
                Range("L6:M7").Clear
                MsgBox "There was some issue getting the totals.", vbExclamation + vbOKOnly
                Exit Sub
            End If
        End If
    End If
End Sub

Private Sub cmdUpdateDropDowns_Click()
    strSQL = "Select Distinct [Product] From [data$] Order by [Product]"
    closeRS
    OpenDB
    cmbProducts.Clear
   
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbProducts.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "I was not able to find any unique Products.", vbCritical + vbOKOnly
        Exit Sub
    End If
   
    '----------------------------
    strSQL = "Select Distinct [Region] From [data$] Order by [Region]"
    closeRS
    OpenDB
    cmbRegion.Clear
   
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbRegion.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "I was not able to find any unique Region(s).", vbCritical + vbOKOnly
        Exit Sub
    End If
    '----------------------
    strSQL = "Select Distinct [Customer Type] From [data$] Order by [Customer Type]"
    closeRS
    OpenDB
    cmbCustomerType.Clear
   
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbCustomerType.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "I was not able to find any unique Customer Type(s).", vbCritical + vbOKOnly
        Exit Sub
    End If
End Sub

---

Here they are.
1st clears all
2nd fills CB's
3rd gets desired data

Code:

---

Private Sub cmdReset_Click()
    'clear the data
    cmbProducts.Clear
    cmbCustomerType.Clear
    cmbRegion.Clear
    With Sheets("View")
        .Visible = True
        .Range("dataSet").CurrentRegion.Offset(1).ClearContents
    End With
End Sub

Private Sub cmdUpdateDropDowns_Click()

    sn = Sheets("data").Range("C3:E472")
    For j = 1 To 3
        With CreateObject("System.Collections.ArrayList")
            For jj = 1 To UBound(sn, 1)
                If sn(jj, j) <> vbNullString Then
                    If Not .Contains(CStr(sn(jj, j))) Then .Add CStr((sn(jj, j)))
                End If
            Next
        .Sort
        Choose(j, cmbProducts, cmbRegion, cmbCustomerType).List = Application.Transpose(.toarray)
        End With
    Next
   
End Sub

Private Sub cmdShowData_Click()

    Dim rngTarget As Range, i As Integer
    Application.ScreenUpdating = False
    Sheets("View").Range("dataSet").CurrentRegion.Offset(1).ClearContents
    With Worksheets("data")
        Set rngTarget = .Range("A1:J" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With rngTarget
            For i = 1 To 3
                .AutoFilter i + 2, Choose(i, cmbProducts.Text, cmbRegion.Text, cmbCustomerType.Text)
            Next
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("B13")
            .AutoFilter
        End With
    End With
    Application.ScreenUpdating = True

End Sub

---

Thanks for your replay but following codes are giving compile and syntax error

Code:

---

Private Sub cmdShowData_Click()

    Dim rngTarget As Range, i As Integer
    Application.ScreenUpdating = False
    Sheets("View").Range("dataSet").CurrentRegion.Offset(1).ClearContents
    With Worksheets("data")
        Set rngTarget = .Range("A1:J" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With rngTarget
            For i = 1 To 3
                .AutoFilter i + 2, Choose(i, cmbProducts.Text, cmbRegion.Text, cmbCustomerType.Text)
            Next
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("B13")
            .AutoFilter
        End With
    End With
    Application.ScreenUpdating = True

End Sub

---

Works fine for me.

Thanks Bakerman , it is working fine now