1
\$\begingroup\$

I had a task to create a VBA macros which will take a matrix data set with products in rows and persons as a columns (on intersection we have an ordered qty for each material for each person) and convert it into a CSV file for Advantix to load. As I'm new to VBA, I spent a couple of days investigating the forums and searching for a Subroutines for particular tasks, like: open the matrix with data, clear data sheet, read the data from matrix and convert it into needed CSV format, export it to external file and simple error handling.

As I don't have that much of programming experience, I'd like somebody to review the code and make it more reliable and optimised.

Global Const DAODBEngine = "DAO.DBEngine.36"
Global intColBeg As Integer                 'Column Index with Data set to analyze'
Global intRowBeg As Integer                 'Row Index with Data set to analyze'


Sub FileOpen()
    Dim filePath As String
    filePath = Application.GetOpenFilename()
    If filePath = "False" Then Exit Sub
    ThisWorkbook.Sheets("BASE").Cells(4, 3) = filePath
End Sub

Sub ClearData()
    ' Check if DATA Sheet exists '
    If Evaluate("ISREF('" & "DATA" & "'!A1)") Then
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("DATA").Delete
        Application.DisplayAlerts = True
    End If

    Dim sheet As Worksheet
    ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "DATA"

End Sub


' This function reads data and adds it to DATA Sheet '

Sub ReadData()
    Dim i As Integer, l As Integer
    Dim intColumn As Integer, intRow As Integer
    Dim intAddRow As Integer
    Dim wbCopyFrom As Workbook
    Dim wbCopyTo As Workbook
    Dim wsCopyFrom As Worksheet
    Dim wsCopyTo As Worksheet
    Dim dataLoc As String, wbLoc As String
    Dim mandant As String
    Dim orderId As String
    Dim orderNum As Integer
    Dim shipDate As Date
    Dim r As Integer

    dataLoc = Trim(ThisWorkbook.Sheets("BASE").Cells(4, 3).Text)

    Set wbCopyFrom = Workbooks.Open(dataLoc)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)

    ThisWorkbook.Activate

    Call ClearData              ' Clears all the data on DATA Sheet '

    Set wbCopyTo = ThisWorkbook
    Set wsCopyTo = wbCopyTo.Sheets("DATA")

    wbCopyTo.Activate

    mandant = wbCopyTo.Sheets("BASE").Cells(11, 3).Text
    orderId = wbCopyTo.Sheets("BASE").Cells(7, 3).Text
    shipDate = wbCopyTo.Sheets("BASE").Cells(9, 3).Text


    ' Initial upper left row/column where matrix data begins '

    intColBeg = 4
    intRowBeg = 4

    intColumn = intColBeg
    intRow = intRowBeg
    intAddRow = 1               ' We will add data from this row '

    orderNum = 1

    While Trim(wsCopyFrom.Cells(intRowBeg - 1, intColumn).Text) <> ""

        ' Header of an Order '

        wsCopyTo.Cells(intAddRow, 1) = "H;OUT;" & mandant & ";" & orderId & "/" & orderNum & ";" & _
                ";;" & Mid(shipDate, 7, 4) & Mid(shipDate, 4, 2) & Mid(shipDate, 1, 2) & ";" & _
                Trim(wsCopyFrom.Cells(3, intColumn).Text) & ";" & Trim(wsCopyFrom.Cells(2, intColumn).Text) & _
                ";;;;;;;999;;"

        r = 1

        intAddRow = intAddRow + 1

        While Trim(wsCopyFrom.Cells(intRow, intColBeg - 1).Text) <> ""
            If (Trim(wsCopyFrom.Cells(intRow, intColumn).Text) <> "") Then
                If Round(CDbl(Trim(wsCopyFrom.Cells(intRow, intColumn).Value)), 0) > 0 Then

                    ' Rows of an Order '

                    wsCopyTo.Cells(intAddRow, 1) = "I;" & orderId & "/" & orderNum & ";" & r & ";" & _
                    Trim(wsCopyFrom.Cells(intRow, 1).Text) & ";" & Trim(wsCopyFrom.Cells(intRow, intColumn).Value) & _
                    ";PCE;;;;;;;;;;;;;;;"

                    r = r + 1

                    intAddRow = intAddRow + 1
                End If
            End If

            intRow = intRow + 1
        Wend

        intRow = intRowBeg

        intColumn = intColumn + 1

        orderNum = orderNum + 1

    Wend

    wbCopyFrom.Close
    wbCopyTo.Sheets("BASE").Activate

End Sub

Sub Export()
Dim MyPath As String
Dim MyFileName As String

MyFileName = "Orders_" & Sheets("BASE").Cells(7, 3).Text & "_" & Format(Date, "ddmmyyyy")

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("DATA").Copy

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = "" '<~~ The start folder path for the file picker.'
    If .Show <> -1 Then GoTo NextCode
    MyPath = .SelectedItems(1) & "\"
End With
    ' Save and error handling'
NextCode:

If MyPath <> "" Then
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs fileName:=MyPath & MyFileName, AccessMode:=xlExclusive, FileFormat:=xlCSV, CreateBackup:=False, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
        .Close False
    End With
    Application.DisplayAlerts = True
Else
    On Error Resume Next
    ActiveWorkbook.Close SaveChanges:=False
    If Err.Number = 1004 Then
        On Error GoTo 0
    End If
End If

End Sub
\$\endgroup\$
  • \$\begingroup\$ Does this work? You Dim r in a While. \$\endgroup\$ – Raystafarian Sep 6 '16 at 13:04
  • \$\begingroup\$ @Raystafarian, Actually it does, but I'm not sure that this is the right way. Assume that 'Dim' should be not in any kind of loop process ... \$\endgroup\$ – Denik Gorbunov Sep 6 '16 at 13:08
1
\$\begingroup\$

Okay, I'll start us off.

You've declared all of your variables - good job. Something you can do is always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Naming

Let's get this out of the way. There are Standard VBA naming conventions that have camelCase for local variables and PascalCase for other variables and names.

Additionally - there's no need for the hungarian notation - it doesn't add anything.

Procedures

Use your variable names to describe exactly what they are and what they are meant to do. First, let's take a look at your procedures:

  • FileOpen (for what?) GetFilePathToOpen
  • ReadData - From where? CopyDataBetweenWBs
  • Export - what are you exporting? To where?

You get the gist. I see you also Call ClearData - You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument.

Globals

  • Global intColBeg As Integer
  • Global intRowBeg As Integer

I only see these used in ReadData - no need for Global. Even if they were used across procedures, you can pass them from one another like ReadData(ByVal intColBeg as Long and just ReadData intColBeg

I don't see Global Const DAODBEngine = "DAO.DBEngine.36" used at all. Also, Const would be named using UPPER_SNAKE_CASE

Variables

First off, integers are obsolete. According to msdn VBA silently converts all integers to long.

  • Dim filePath As String - good
  • Dim sheet As Worksheet - what sheet? A sourceSheet or maybe a targetSheet? Surely not just a sheet.
  • Dim intColumn As Integer, intRow As Integer good job giving both of them a type - a lot of people don't remember that. That being said, there's no real reason to stack them like that, just give them their own line.
  • Dim i as Long
  • Dim l as Integer - are you using l because it's similar to i? For iterating in VBA you can use i and j, sometimes k - but it'd be better to describe what's being iterated. Also, I don't see l being used anywhere.
  • intColumn and intRow - currentRow and currentColumn? lastRow and lastColumn? See how it'd be better to describe what it is doing?
  • wbCopyFrom & wsCopyFrom - sourceWorkbook and sourceSheet? Same for CopyTo - targetSheet etc
  • dataLoc and wbLoc - abbreviating the words isn't needed - letters are free. targetSheetLocation or file path, directory, whatever.
  • mandant - I don't know what this would be.
  • orderID, orderNumber, shippingDate - you get the picture
  • Dim r as Integer - you know what I'm saying
  • MyPath and MyFileName - destinationPath and exportedFileName

Looks to me like DATA and BASE are used multiple times, why not create a constant string for each and use that, in case it ever changes you only need to change it in one place.


Error Handling

  • If .Show <> -1 Then GoTo NextCode
  • On Error Resume Next
  • On Error GoTo 0

That second one Resume Next - that's your worst enemy. You won't know if an error occurs now. Instead, create an error handler and send errors there. Check explicitly for errors and avoid them rather than just throwing them with a GoTo. You'll thank yourself later.

If Not .Show <> -1 Then
'Do Thing
End if
'NextCode

Now, you just act during the TRUE condition, otherwise that part of the code doesn't execute and you don't need a GoTo.

What happens if DATA or BASE don't exist? I don't see those errors being handled. Whoops -

If Evaluate("ISREF('" & "DATA" & "'!A1)") Then

That is a new one for me! Clever, but not the best practice. This question (and many of its duplicates) will show you better ways.


While

This chunk of code is intimidating, honestly

While Trim(wsCopyFrom.Cells(intRowBeg - 1, intColumn).Text) <> ""

        ' Header of an Order '

        wsCopyTo.Cells(intAddRow, 1) = "H;OUT;" & mandant & ";" & orderId & "/" & orderNum & ";" & _
                ";;" & Mid(shipDate, 7, 4) & Mid(shipDate, 4, 2) & Mid(shipDate, 1, 2) & ";" & _
                Trim(wsCopyFrom.Cells(3, intColumn).Text) & ";" & Trim(wsCopyFrom.Cells(2, intColumn).Text) & _
                ";;;;;;;999;;"

        r = 1

        intAddRow = intAddRow + 1

        While Trim(wsCopyFrom.Cells(intRow, intColBeg - 1).Text) <> ""
            If (Trim(wsCopyFrom.Cells(intRow, intColumn).Text) <> "") Then
                If Round(CDbl(Trim(wsCopyFrom.Cells(intRow, intColumn).Value)), 0) > 0 Then

                    ' Rows of an Order '

                    wsCopyTo.Cells(intAddRow, 1) = "I;" & orderId & "/" & orderNum & ";" & r & ";" & _
                    Trim(wsCopyFrom.Cells(intRow, 1).Text) & ";" & Trim(wsCopyFrom.Cells(intRow, intColumn).Value) & _
                    ";PCE;;;;;;;;;;;;;;;"

                    r = r + 1

                    intAddRow = intAddRow + 1
                End If
            End If

            intRow = intRow + 1
        Wend

        intRow = intRowBeg

        intColumn = intColumn + 1

        orderNum = orderNum + 1

    Wend

If I were to come to need and need to maintain it, I might just end up rewriting the whole thing instead of decoding it.

My recommendation -

Dim lastRow as Long
lastRow = WsCopyTo.Cells(Rows.Count,1).End(xlup).Row
For i = 1 to lastRow

Now you don't need the Whiles and you don't need to iterate like this -

  • intAddRow = intAddRow + 1
  • intRow = intRowBeg (Is this just a reset? That should be done at the top rather than the bottom of the loop)
  • intColumn = intColumn + 1
  • OrderNum = orderNum + 1

Just use your found numbers and use a For Next loop to iterate everything with the same i.

Here - Trim(wsCopyFrom.Cells(intRow, intColBeg - 1).Text) <> ""

You're checking that it's not empty and not full of blank characters, right? There's got to be a better way -

If Not Trim(wsCopyFrom.Cells(intRow, intColBeg - 1) = vbNullString

or

If Len(Trim(wsCopyFrom.Cells(intRow, intColBeg - 1)) > 0

I just don't like the "" usage when there are better options available in VBA.

Also, it seems to me that you could probably do the "copying" of cells as an entire range at once rather than one by one.

Re: all that white space - I'm not sure how I feel about it. It seems excessive and unorganized, but considering what's happening there, it might be worth the excess white space just for readability. If you manage to go to a For, I'm sure a lot of the blank space can be eliminated.


Cells

I see

  • ThisWorkbook.Sheets("BASE").Cells(4, 3)
  • "Orders_" & Sheets("BASE").Cells(7, 3).Text & "_" & Format(Date, "ddmmyyyy")
  • dataLoc = Trim(ThisWorkbook.Sheets("BASE").Cells(4, 3).Text)
  • mandant = wbCopyTo.Sheets("BASE").Cells(11, 3).Text
  • orderId = wbCopyTo.Sheets("BASE").Cells(7, 3).Text
  • shipDate = wbCopyTo.Sheets("BASE").Cells(9, 3).Text

Instead of hard-coding names, if they are static, assign them a named range property. e.g. instead of Sheets("mySheet").Range("A1:A10") you can have mysheet.Range("MyNamedRange").

Since they will always be in that position, name the range, or name the column and take the index of it.


Comments

I see you have some comments, probably to yourself, but if you utilize the descriptive naming, you won't need those unless you need to mark an error to fix.

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.


.Activate

I see three .Activates

  • ThisWorkbook.Activate
  • wbCopyTo.Activate
  • wbCopyTo.Sheets("BASE").Activate

In general, you shouldn't need to use .Activate - it's like .Select. Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes.

There's a good question on StackOverflow addressing this - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros.

Now, I know sometimes excel gets tricky and forces an activate because of whatever Objects it's dealing with - but I'm pretty sure that's not the case here. You don't need to wbCopyTo.Activate to

mandant = wbCopyTo.Sheets("BASE").Cells(11, 3).Text
orderId = wbCopyTo.Sheets("BASE").Cells(7, 3).Text
shipDate = wbCopyTo.Sheets("BASE").Cells(9, 3).Text

You can probably just get rid of the activate altogether. You're already qualifying your cells with a sheet and a book, so it shouldn't need to be active.


Refactoring

I don't really have the ability right now to see if you have refactoring opportunities and it doesn't seem like you need any Functions. But someone else might see that and perhaps can help you with that, and with making your Sub procedures Private ;)

\$\endgroup\$
0
\$\begingroup\$

that was really interesting for me to go through all your comments and finally after some time I decided to re-write the code and make it more clear and simple.

I really enjoyed Ranges and used them in my code. I decided not to use DATA Sheet as there is no need in it at all for me. I create a new csv file and write data to it. Not sure how optimal is this approach.

There are still questions oh error handling: how to check if I have write permission to the folder specified or how to check if the file is already in the specified location and delete the previous version and so on.

Appreciate the time you spent and all your valuable comments. Here is the code I have at the moment (I initially left blank lines to have a code visibility and for better reading):

Option Explicit

' This Routine works independently as it's assigned to a Button on a Sheet

Sub GetFilePathToOpen()
    Dim path As String
    path = Application.GetOpenFilename()
    If path = "False" Then Exit Sub
    Sheets("BASE").Cells(4, 3) = path
End Sub

Sub WriteCSVFile()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim csvFilePath As String
    Dim csvFileName As String
    Dim csvFile As Integer
    Dim params As Range
    Dim person As Range
    Dim material As Range
    Dim city As Range
    Dim address As Range
    Dim i As Integer
    Dim j As Integer
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim column As Long
    Dim row As Long
    Dim orderHeadLine As String
    Dim orderDetLine As String
    Dim orderID As String
    Dim orderDate As String
    Dim mandant As String

    Set wb = ThisWorkbook
    With wb
        Set ws = .Worksheets("BASE")
    End With
    With ws
        Set params = .Range("C:C")
    End With

    orderID = Trim(params(7).Text)
    orderDate = Mid(params(9).Value, 1, 2) & Mid(params(9).Value, 4, 2) & Mid(params(9).Value, 7, 4)
    mandant = Format(params(11).Value, "0000")

    column = 4                              ' First column with the data on a sourceSheet
    row = 4                                 ' First row with the data on a sourceSheet

    csvFileName = "LSR_Promo_" & orderID & "_" & Format(Date, "ddmmyyyy") & ".csv"
    csvFile = FreeFile

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ""
        .Show
            If .SelectedItems.Count = 0 Then
                MsgBox "No Folder selected."
                Exit Sub
            Else
                csvFilePath = .SelectedItems(1) & "\"
            End If
    End With

    If csvFilePath <> "" Then
        Open csvFilePath & csvFileName For Output Lock Write As #csvFile
    Else
        On Error GoTo ErrorHandler
    End If

    Set sourceWorkbook = Workbooks.Open(params(4).Value)
    Set sourceSheet = sourceWorkbook.Sheets(1)


    lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).row
    lastColumn = sourceSheet.Cells(3, Columns.Count).End(xlToLeft).column

    With sourceSheet
        Set address = .Range(Cells(row - 3, column), Cells(row - 3, lastColumn))
        Set city = .Range(Cells(row - 2, column), Cells(row - 2, lastColumn))
        Set person = .Range(Cells(row - 1, column), Cells(row - 1, lastColumn))
        Set material = .Range(Cells(row, 1), Cells(lastRow, 1))
    End With

    For i = 1 To person.Count
        orderHeadLine = "H;OUT;" & mandant & ";" & orderID & "_" & i & ";" & _
                        ";;" & orderDate & ";" & Trim(person(i).Text) & ";" & Trim(city(i).Text) & "," & _
                        Trim(address(i).Text) & ";LSB;;;;;;;999;;;"
        Print #csvFile, orderHeadLine

        For j = 1 To material.Count
            orderDetLine = "I;" & orderID & "_" & i & ";" & j & ";" & _
                            Trim(material(j).Text) & ";" & Trim(Cells(material(j).row, person(i).column).Value) & _
                            ";PCE;;;;;;;;;;;;;"
            Print #csvFile, orderDetLine
        Next j
    Next i

    sourceWorkbook.Close
    Close csvFile

' This is the toughest part of the code as I don't have a clue how to handle errors

ErrorHandler:
    Select Case Err.Number
        Case 0
            'No error
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
        End
    End Select

End Sub
\$\endgroup\$

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.