# Generate Orders from Matrix and save as CSV

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
ThisWorkbook.Sheets("DATA").Delete
End If

Dim sheet As Worksheet

End Sub

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

Dim i As Integer, l As Integer
Dim intColumn As Integer, intRow 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

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

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
With ActiveWorkbook
.SaveAs fileName:=MyPath & MyFileName, AccessMode:=xlExclusive, FileFormat:=xlCSV, CreateBackup:=False, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
.Close False
End With
Else
On Error Resume Next
ActiveWorkbook.Close SaveChanges:=False
If Err.Number = 1004 Then
On Error GoTo 0
End If
End If

End Sub

• Does this work? You Dim r in a While. – Raystafarian Sep 6 '16 at 13:04
• @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 ... – Denik Gorbunov Sep 6 '16 at 13:08

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

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

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.

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 ;)

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 i As Integer
Dim j As Integer
Dim lastRow As Long
Dim lastColumn As Long
Dim column As Long
Dim row As Long
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) & "," & _

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