5
\$\begingroup\$

I am hoping I can get some guidance on some better "best practice" suggestions on how to handle this kind of code set. I understand that parameterized queries are a thing, but I am not quite there yet, but feel free to drop link to good tutorial on that if you must include that as part of your suggestion.

Here is my code that works well, but I am trying to optimize performance. I thought about dumping RecordSet into an array but i am not sure how helpful that would be? I am pretty open to anything here as I would love to develop best practices in my learning structure.

I know this breaks a cardinal rule about not interacting with the worksheet directly unless needed, but I don't know a way around it with this particular scenario.

Private Sub CommandButton1_Click()
    Dim fso As FileSystemObject: Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset: Dim strConnection As String
    Dim i As Integer, fld As Object: Dim TotalRec As Long
    Dim RecordNum As Long: Dim filelocation1 As String
    Dim wBo As Workbook: Dim wsO As Worksheet
    Dim answer As Integer: Dim myValue As Variant
    Dim count As Long: Dim src As CodeModule
    Dim dest As CodeModule: Dim QUV As Long
    Dim IID As Long: Dim rCell As Range: Dim rRng As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    count = 1
    myValue = InputBox("What was the last order number?")
    RecordNum = myValue
    Set wBo = ActiveWorkbook
    With wBo
        Set wsO = wBo.Sheets("Sheet1")
        Sheets(1).Activate
        strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathtoFile" & "\" & ".accdb"
        con.Open strConnection
        rs.Open "SELECT MAX(ORDERNO) AS MaxAmtOrders FROM dbo_ITEMS", con
        Sheets(1).Range("Z1").CopyFromRecordset rs
        rs.Close
        con.Close 
        TotalRec = wBo.Sheets("Sheet1").Range("Z1").Value     
        For y = myValue To TotalRec
            If count >= TotalRec Then Exit For
            strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathtoFile" & "\" & ".accdb"
            con.Open strConnection
            Sheets(1).Activate
            rs.Open "SELECT [30 on hand].Expr1 AS [Item#], " & _
                    "[30 on hand].IVDESC3 AS Brand, " & _
                    "[30 on hand].IVDESC1 AS Discription, " & _
                    "[30 on hand].IVALU, " & _
                    "[30 on hand].IVQTY001 AS [001 OH], " & _
                    "Sum(dbo_ITEMS.QUANTO) AS [Order QTY], " & _
                    "[30 on hand].IVAUX6 " & _
                    "FROM dbo_ITEMS INNER JOIN [30 on hand] ON dbo_ITEMS.ITEM = [30 on hand].Expr1 " & _
                    "WHERE ((dbo_ITEMS.ORDERNO) Between " & RecordNum & " And " & RecordNum + 25 & " AND ((dbo_ITEMS.ITEM_STATE)='cm')) " & _
                    "GROUP BY [30 on hand].Expr1, [30 on hand].IVDESC3, [30 on hand].IVDESC1, [30 on hand].IVALU, [30 on hand].IVQTY001, [30 on hand].IVAUX6 " & _
                    "ORDER BY [30 on hand].IVAUX6;", con
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(2, 0).Value = " "
            If RecordNum + 25 < TotalRec Then
                wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 1).Value = "Order Numbers " & RecordNum & " - " & RecordNum + 25
            ElseIf RecordNum >= TotalRec Then
                Exit For
            Else
                wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 1).Value = "Order Numbers " & RecordNum & " - " & TotalRec
            End If
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 1).Interior.Color = RGB(153, 255, 255)
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(2, 0) = "Item#"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 1) = "Brand"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 2) = "Description"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 3) = "UPC"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 4) = "Store 001 OH"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 5) = "Order Quanity"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 6) = "Store 001 Loc"
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(0, 1).Activate
            wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).Offset(2, 0).CopyFromRecordset rs
            rs.Close
            con.Close
            strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathtoFile" & "\" & ".accdb""
            con.Open strConnection
            Sheets(5).Activate
            rs.Open "SELECT [30 on hand].Expr1 AS [Item#], " & _
                    "[30 on hand].IVDESC3 AS Brand, " & _
                    "[30 on hand].IVDESC1 AS Discription, " & _
                    "[30 on hand].IVALU, " & _
                    "[30 on hand].IVQTY001 AS [001 OH], " & _
                    "Sum(dbo_ITEMS.QUANTO) AS [Order QTY], " & _
                    "[30 on hand].IVAUX6 " & _
                    "FROM dbo_ITEMS INNER JOIN [30 on hand] ON dbo_ITEMS.ITEM = [30 on hand].Expr1 " & _
                    "WHERE ((dbo_ITEMS.ORDERNO) Between " & RecordNum & " And " & RecordNum + 25 & " AND ((dbo_ITEMS.ITEM_STATE)='cm')) " & _
                    "GROUP BY [30 on hand].Expr1, [30 on hand].IVDESC3, [30 on hand].IVDESC1, [30 on hand].IVALU, [30 on hand].IVQTY001, [30 on hand].IVAUX6 " & _
                    "ORDER BY [30 on hand].IVAUX6;", con
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(2, 0).Value = " "
            If RecordNum + 25 < TotalRec Then
                wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 1).Value = "Order Numbers " & RecordNum & " - " & RecordNum + 25
            ElseIf RecordNum >= TotalRec Then
                Exit For
            Else
                wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 1).Value = "Order Numbers " & RecordNum & " - " & TotalRec
            End If
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 1).Interior.Color = RGB(153, 255, 255)
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(2, 0) = "Item#"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 1) = "Brand"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 2) = "Description"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 3) = "UPC"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 4) = "Store 001 OH"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 5) = "Order Quanity"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 6) = "Store 001 Loc"
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(0, 1).Activate
            wBo.Sheets("Sheet5").Cells(Sheet5.Rows.count, 1).End(xlUp).Offset(2, 0).CopyFromRecordset rs
            rs.Close
            con.Close
            With wBo.Sheets("Sheet5").UsedRange.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Sheets(5).Columns("a").ColumnWidth = 6.57
            Sheets(5).Columns("b").ColumnWidth = 28.57
            Sheets(5).Columns("c").ColumnWidth = 42
            Sheets(5).Columns("d").ColumnWidth = 10.29
            Sheets(5).Columns("e").ColumnWidth = 11.57
            Sheets(5).Columns("f").ColumnWidth = 12.71
            Sheets(5).Columns("g").ColumnWidth = 11.71
            With wBo.Sheets("Sheet5").PageSetup
                .Orientation = xlLandscape
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = False
            End With
            wBo.Sheets("Sheet5").PrintOut
            count = count + 25
            RecordNum = RecordNum + 25
            If count >= TotalRec Then Exit For
            If RecordNum >= TotalRec Then Exit For
            RecordNum = RecordNum + 1
            ActiveWorkbook.Sheets("Sheet5").UsedRange.ClearContents
            With wBo.Sheets("Sheet5").PageSetup
                .Orientation = xlPortrait
            End With
        Next y
        Sheets(1).Columns("a").ColumnWidth = 6.57
        Sheets(1).Columns("b").ColumnWidth = 28.57
        Sheets(1).Columns("c").ColumnWidth = 42
        Sheets(1).Columns("d").ColumnWidth = 10.29
        Sheets(1).Columns("e").ColumnWidth = 11.57
        Sheets(1).Columns("f").ColumnWidth = 12.71
        Sheets(1).Columns("g").ColumnWidth = 11.71
        strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathtoFile" & "\" & ".accdb""
        con.Open strConnection
            rs.Open "SELECT [30 on hand].Expr1 AS [Item#], " & _
                    "[30 on hand].IVDESC3 AS Brand, " & _
                    "[30 on hand].IVDESC1 AS Discription, " & _
                    "[30 on hand].IVALU, " & _
                    "[30 on hand].IVQTY001 AS [001 OH], " & _
                    "[30 on hand].IVQTY000 AS [000 OH], " & _
                    "Sum(dbo_ITEMS.QUANTO) AS [Order QTY], " & _
                    "[30 on hand].IVAUX6, " & _
                    "[30 on hand].IVATTR " & _
                    "FROM dbo_ITEMS INNER JOIN [30 on hand] ON dbo_ITEMS.ITEM = [30 on hand].Expr1 " & _
                    "WHERE ((dbo_ITEMS.ORDERNO) Between " & myValue & " And " & TotalRec & " AND ((dbo_ITEMS.ITEM_STATE)='cm')) " & _
                    "GROUP BY [30 on hand].Expr1, [30 on hand].IVDESC3, [30 on hand].IVDESC1, [30 on hand].IVALU, [30 on hand].IVQTY001, [30 on hand].IVQTY000, [30 on hand].IVAUX6, [30 on hand].IVATTR " & _
                    "ORDER BY [30 on hand].IVAUX6;", con
        i = 0
        Sheets(2).Activate
        ActiveWorkbook.Sheets("Sheet2").Range("a1").Select
        For Each fld In rs.Fields
            ActiveCell.Offset(0, i) = fld.Name
            i = i + 1
        Next fld
        Sheets(2).Range("A2").CopyFromRecordset rs
        Sheets(2).Columns("a").ColumnWidth = 6.57
        Sheets(2).Columns("b").ColumnWidth = 28.57
        Sheets(2).Columns("c").ColumnWidth = 42
        Sheets(2).Columns("d").ColumnWidth = 10.29
        Sheets(2).Columns("e").ColumnWidth = 11.57
        Sheets(2).Columns("f").ColumnWidth = 12.71
        Sheets(2).Columns("g").ColumnWidth = 11.71
        Sheets(2).Columns("K").Formula = "=G1-E1"
        rs.Close
        con.Close
        Set rRng = ActiveWorkbook.Sheets("Sheet2").Range("a2:a100")
        For Each rCell In rRng.Cells
            If rCell <> "" And rCell.Value <> 0 Then
                IID = rCell
                QUV = rCell.Offset(0, 6).Value
                strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathToFile" & "\" & ".accdb"
                con.Open strConnection
                rs.Open "UPDATE [30OnHand] SET [30OnHand].IVQTY001 = [30OnHand].IVQTY001  -" & QUV & " WHERE ((([30OnHand].IVNO)=" & IID & "));", con
                con.Close
            End If
        Next rCell
        ActiveWorkbook.SaveCopyAs ("C:PathToFile" & "\" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".xlsm")
        ActiveWorkbook.Close
    End With
    Sheets(1).Clear
    Sheets(2).Clear
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub
\$\endgroup\$
2
\$\begingroup\$

Variables

  1. You have a bunch of variables that are declared but never used: fso, filelocation1, wsO, answer, src, dest. These add significantly to the clutter at the top of the procedures, which leads to...
  2. Try to declare variables close to where you are using them in code. Not only does this break up the monolithic block of declarations at the top of the procedure to make it more readable, it helps in determining what they are used for.
  3. If you insist on using multiple declarations on the same line, the statement concatenation operator : is superfluous and makes it even more difficult to read (i.e. Dim wBo As Workbook: Dim wsO As Worksheet). VBA already allows comma delimited declarations (like you do here: Dim i As Integer, fld As Object). There isn't a reason to combine them on the same line, and the : operator should be avoided in general because in the vast majority of cultures, text is read from top down.
  4. Put Option Explicit at the top of the module and make sure that all of your variables are declared. The variable y is never declared.
  5. Try to use more meaningful variable names in order to help make your code self-documenting. For example, taken out of context myValue could be mean literally anything.
  6. You're using a hodgepodge of variable naming conventions: Hungarian (strConnection, rRng, etc.), Pascal case (TotalRec, RecordNum), camel case (myValue), and whatever wBo and wsO are. Best would be to follow current convention, but whatever you choose, make it consistent.

Validate Input

RecordNum is declared as a Long, but myValue = InputBox("What was the last order number?") returns a Variant of type String. You then immediately assign it with RecordNum = myValue, which implicitly casts it to a number. If the user cancels the InputBox or types anything other than a number, this will throw a run-time error.

Add Error Handling

This is especially important when you are using external functionality like a database connection. Consider what you would want to happen when a call like con.Open strConnection fails or times out. Currently the wheels would come off, opening the possibility that your database connection never gets closed.

Syntax Consistency

You are using at least 3 different methods of obtaining Worksheet references: Named - Sheets("Sheet1"), by ordinal - Sheets(1), and by object name Sheet5. Not only that, you are repeatedly resolving the same references. Just store them in variables and use the variable so Excel doesn't have to locate them in the Worksheets collection again and again.

Unused With Block

You never make use of the With block here:

With wBo

    '....
End With

Every single reference to wBo inside the block is wBo.Whatever. The point of working inside of a With block is that the reference only needs to be resolved once. If you only use hard references inside of it, it doesn't do anything other than add an additional level of indentation.

Dead and/or Meaningless Code

You are repeatedly calling .Activate on Worksheets, but I can't find anywhere in the code where this actually matters other than the one call to ActiveCell, which should probably be removed. Activating and selecting in Excel is expensive - it is best avoided entirely.

There is no need to use ActiveWorkbook on the line ActiveWorkbook.Sheets("Sheet2").Range("a1").Select (and less reason to select cell A1). Not only do you already have a reference to wBo, you're inside a With block for that reference and there isn't anything in your code that would change the active Workbook.

The "variable" strConnection is never set to anything other than:

"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:PathtoFile" & "\" & ".accdb"

You make the exact same assignment 4 times. It should be converted to a constant.

I'm not sure whether this is intentional or not, but I'm not coming up with a good reason to size the columns in a Worksheet...

Sheets(2).Columns("a").ColumnWidth = 6.57

...and then clear the contents:

Sheets(2).Clear

Speaking of resizing, Sheet(5) is repeatedly resized and formatted to the same values inside of a loop. You also repeatedly write the same values to the column headers inside of a loop wBo.Sheets("Sheet1").Cells(Sheet1.Rows.count, 1).End(xlUp).offset(2, 0) = "Item#"

ADO Issues

You repeatedly open and close the same ADO connection in a nested loop. This is incredibly expensive and completely unnecessary. Open the connection when you start, and close it when you finish.

You've already noted that the queries aren't parametrized, so I won't belabour that point other than to mention that this isn't really safe. Check out the VBA documentation page over on SO for an example. On huge benefit this offers for readability is that you can move your queries out of the procedure itself and make them constants. That way your code isn't cluttered with sections like this:

rs.Open "SELECT [30 on hand].Expr1 AS [Item#], " & _
        "[30 on hand].IVDESC3 AS Brand, " & _
        "[30 on hand].IVDESC1 AS Discription, " & _
        "[30 on hand].IVALU, " & _
        "[30 on hand].IVQTY001 AS [001 OH], " & _
        "Sum(dbo_ITEMS.QUANTO) AS [Order QTY], " & _
        "[30 on hand].IVAUX6 " & _
        "FROM dbo_ITEMS INNER JOIN [30 on hand] ON dbo_ITEMS.ITEM = [30 on hand].Expr1 " & _
        "WHERE ((dbo_ITEMS.ORDERNO) Between " & RecordNum & " And " & RecordNum + 25 & " AND ((dbo_ITEMS.ITEM_STATE)='cm')) " & _
        "GROUP BY [30 on hand].Expr1, [30 on hand].IVDESC3, [30 on hand].IVDESC1, [30 on hand].IVALU, [30 on hand].IVQTY001, [30 on hand].IVAUX6 " & _
        "ORDER BY [30 on hand].IVAUX6;", con
\$\endgroup\$
  • \$\begingroup\$ Well I guess most of this is stuff I already knew, but as far as notation goes I wasnt aware of the different styles. However, I do have a question about opening and closing recordset. The reason I did it like this was I wasnt able to do multiple queries without closing and opening again. I guess that was a band aid thing till i figured out something that worked better? I would love a better tutorial on that if you happen to have one :) \$\endgroup\$ – Doug Coats Jul 26 '16 at 13:10
  • 1
    \$\begingroup\$ @DougCoats - The reason you have to close the connection to requery is that you're passing SQL directly to the Connection object. If you use ADODB.Commands, the query isn't tied up in the connection state. \$\endgroup\$ – Comintern Jul 26 '16 at 13:32
  • \$\begingroup\$ This is good information, thanks! I def need to work on my vba connections then. \$\endgroup\$ – Doug Coats Jul 26 '16 at 13:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.