Covert SQL Code to VBA

**ayazgreat** · 08-26-2013, 02:06 AM

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

**bakerman** · 08-26-2013, 10:12 AM

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

**ayazgreat** · 08-26-2013, 02:10 PM

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

**bakerman** · 08-26-2013, 10:26 PM

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

**ayazgreat** · 08-27-2013, 12:25 AM

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