Manipulating an existing Excel file and creating CVS files automatically

[erik11]

Dear people at MrExcel.com

Some years ago I did some programming in Excel VBA. Now however I am quite rusty in this department. I hope someone can push me in the right direction in order to write a procedure, which will automatically manipulate a certain Excel file, containing more than a thousand lines and finally produce a number of comma-separated CVS files. It is most easily explained in the below figure, containing a much reduced example. Columns containing data of students attending a school has been retrieved from the computersystem at the school. Four columns: Class, login, firstname and lastname. What needs to be done is:

1. Delete rows in which the login cell is empty
2. Filling out the email Column with the login in front of "@school.com"
3. Copying the login Column to the student as well as the password Column.
4. Filling out the role Column with "STUDENT" in every entry.

This should give the second picture below. Finally one comma-separated file should be created for every class (without the Class Column data) like shown on the last two pictures.

I hope someone can push me in the right direction ...

Regards,

Erik

 

[alansidman]

This will get you to the point of completing the worksheet. Once you have this, you can filter the file on Column A and save the files as comma delimited files.

Option Explicit


Sub school()
    Dim lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long
    For i = lr To 2 Step -1
        If Range("B" & i) = "" Then Range("B" & i).EntireRow.Delete
    Next i
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Range("E2:E" & lr).FormulaR1C1 = "=RC[-3] & ""school.com"""
    Range("F2:F" & lr).FormulaR1C1 = "=RC[-4]"
    Range("G2:G" & lr).FormulaR1C1 = "=RC[-5]"
    Range("H2:H" & lr).FormulaR1C1 = "Student"
    lr = Range("A" & Rows.Count).End(xlUp).Row
End Sub

 

[BQardi]

This should do what you want:

Sub CreateIndividualStudentCSVFiles()
Dim rw As Long, CSVsavePath As Long
Dim strClass As String, strLogin As String[COLOR=#008000]
'Turn screenupdating off, makes code a little faster and not so confusing to look at :-)[/COLOR]
Application.ScreenUpdating = False
'In case of unexpected errors
On Error GoTo ErrHandler
rw = 2[COLOR=#008000]
'Loop for whole range (all classes) loops until "blank" cell is reached[/COLOR]
Do While Not Range("A" & rw).Value = ""[COLOR=#008000]
    'Put class name in a variable[/COLOR]
    strClass = Range("A" & rw).Value[COLOR=#008000]
    'Loop for current class[/COLOR]
    Do While Range("A" & rw).Value = strClass[COLOR=#008000]
        'Put login in a variable[/COLOR]
        strLogin = Range("B" & rw).Value
        If strLogin = "" Then[COLOR=#008000]
            'Delete rows in which the login cell is empty[/COLOR]
            Range("A" & rw).EntireRow.Delete xlShiftUp
        Else[COLOR=#008000]
            'Filling out the email Column with the login in front of "@school.com"[/COLOR]
            Range("E" & rw).Value = strLogin & "@school.com"[COLOR=#008000]
            'Copying the login Column to the student as well as the password Column.[/COLOR]
            Range("F" & rw).Value = strLogin
            Range("G" & rw).Value = strLogin[COLOR=#008000]
            'Filling out the role Column with "STUDENT" in every entry.[/COLOR]
            Range("H" & rw).Value = "STUDENT"
            rw = rw + 1
        End If
    Loop
    rw = rw - 1[COLOR=#008000]
    'Check if at least one row had a login (if not, all would have been deleted and Range("A" & rw).Value would be "login")[/COLOR]
    If Range("A" & rw).Value = strClass Then[COLOR=#008000]
        'Copy range for current class, add a new temporary workbook and paste[/COLOR]
        Range("A1:H" & rw).Copy
        Workbooks.Add
        ActiveSheet.Paste[COLOR=#008000]
        'Disable popup if csv file already exists. Overwrite file (delete codeline if you want popups)[/COLOR]
        Application.DisplayAlerts = False[COLOR=#008000]
        'Save CSV file. [/COLOR][COLOR=#ff0000]IMPORTANT! Change path to where you want csv files to be saved to[/COLOR]
        ActiveWorkbook.SaveAs Filename:= _
            "[COLOR=#ff0000]C:\MrExcelTest\CSVtest[/COLOR]\" & strClass & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False[COLOR=#008000]
        'Turn popup warnings back on[/COLOR]
        Application.DisplayAlerts = True[COLOR=#008000]
        'Close temporary file (without saving)[/COLOR]
        ActiveWorkbook.Close False[COLOR=#008000]
        'Reactivate this workbook[/COLOR]
        ThisWorkbook.Activate[COLOR=#008000]
        'Delete range for current class, for next class to be processed[/COLOR]
        Range("A2:H" & rw).Delete xlShiftUp
    End If
    rw = 2
Loop
Exit Sub
ErrHandler:
MsgBox "Something went wrong! I'm not so happy now... Aborting" & vbCrLf & _
       vbCrLf & _
       "Error number: " & Err.Number & vbCrLf & _
       "Error description: " & Err.Description, vbCritical
End Sub

 

[erik11]

This should do what you want:

Sub CreateIndividualStudentCSVFiles()
Dim rw As Long, CSVsavePath As Long
Dim strClass As String, strLogin As String[COLOR=#008000]
'Turn screenupdating off, makes code a little faster and not so confusing to look at :-)[/COLOR]
Application.ScreenUpdating = False
'In case of unexpected errors
On Error GoTo ErrHandler
rw = 2[COLOR=#008000]
'Loop for whole range (all classes) loops until "blank" cell is reached[/COLOR]
Do While Not Range("A" & rw).Value = ""[COLOR=#008000]
    'Put class name in a variable[/COLOR]
    strClass = Range("A" & rw).Value[COLOR=#008000]
    'Loop for current class[/COLOR]
    Do While Range("A" & rw).Value = strClass[COLOR=#008000]
        'Put login in a variable[/COLOR]
        strLogin = Range("B" & rw).Value
        If strLogin = "" Then[COLOR=#008000]
            'Delete rows in which the login cell is empty[/COLOR]
            Range("A" & rw).EntireRow.Delete xlShiftUp
        Else[COLOR=#008000]
            'Filling out the email Column with the login in front of "@school.com"[/COLOR]
            Range("E" & rw).Value = strLogin & "@school.com"[COLOR=#008000]
            'Copying the login Column to the student as well as the password Column.[/COLOR]
            Range("F" & rw).Value = strLogin
            Range("G" & rw).Value = strLogin[COLOR=#008000]
            'Filling out the role Column with "STUDENT" in every entry.[/COLOR]
            Range("H" & rw).Value = "STUDENT"
            rw = rw + 1
        End If
    Loop
    rw = rw - 1[COLOR=#008000]
    'Check if at least one row had a login (if not, all would have been deleted and Range("A" & rw).Value would be "login")[/COLOR]
    If Range("A" & rw).Value = strClass Then[COLOR=#008000]
        'Copy range for current class, add a new temporary workbook and paste[/COLOR]
        Range("A1:H" & rw).Copy
        Workbooks.Add
        ActiveSheet.Paste[COLOR=#008000]
        'Disable popup if csv file already exists. Overwrite file (delete codeline if you want popups)[/COLOR]
        Application.DisplayAlerts = False[COLOR=#008000]
        'Save CSV file. [/COLOR][COLOR=#ff0000]IMPORTANT! Change path to where you want csv files to be saved to[/COLOR]
        ActiveWorkbook.SaveAs Filename:= _
            "[COLOR=#ff0000]C:\MrExcelTest\CSVtest[/COLOR]\" & strClass & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False[COLOR=#008000]
        'Turn popup warnings back on[/COLOR]
        Application.DisplayAlerts = True[COLOR=#008000]
        'Close temporary file (without saving)[/COLOR]
        ActiveWorkbook.Close False[COLOR=#008000]
        'Reactivate this workbook[/COLOR]
        ThisWorkbook.Activate[COLOR=#008000]
        'Delete range for current class, for next class to be processed[/COLOR]
        Range("A2:H" & rw).Delete xlShiftUp
    End If
    rw = 2
Loop
Exit Sub
ErrHandler:
MsgBox "Something went wrong! I'm not so happy now... Aborting" & vbCrLf & _
       vbCrLf & _
       "Error number: " & Err.Number & vbCrLf & _
       "Error description: " & Err.Description, vbCritical
End Sub

Excellent! Thanks to both of you. I will look into this tomorrow ...

Regards,

Erik

 

[erik11]

Again big thanks to both of you! The first solution is rather simple and will do the first part. Then a filtering can be done manually afterwards. Nice.

BQardi's solution is impressing, finishing all 38 class files completely in 10 seconds!! Because of the detailed code containing comments, I could easily follow the idea. Since I didn't want the first column in every Class file to appear, I had to correct a simple error: Just replacing A with a B here:

Range("B1:H" & rw).Copy instead of Range("A1:H" & rw).Copy

Besides it later turned out that I wanted the comma-separated CVS files saved as text files. It was easily done by replacing

"C:\MrExcelTest\CSVtest" & strClass & ".csv", _ with "C:\MrExcelTest\CSVtest" & strClass & ".txt", _

It is easy to edit the line containing the path for the files to be saved, but I am curious now: Would it be possible to have the code open a Windows dialog box in which I can browse for the destination?

Regards,

Erik

 

[BQardi]

Sure is (note that ALL your txt files would be saved in the selected folder, I don't think it would be wishfull to show the dialog for each class, f. ex. if you have 100 different classes in the list, the dialog would popup a 100 times, but if that is what you want, it can be done, with a little tweak...):

Sub CreateIndividualStudentCSVFiles()
Dim rw As Long, CSVsavePath As Long
Dim strClass As String, strLogin As String
[COLOR=#ff0000]Dim FolderPath As String[/COLOR]
'Turn screenupdating off, makes code a little faster and not so confusing to look at :-)
Application.ScreenUpdating = False

'Show folder dialog picker to choose destination path
'FolderPath = vbNullString

[COLOR=#ff0000]With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "C:\" [/COLOR][COLOR=#008000]'You can change path to where you want the initial path to be (startpath shown in dialog) if omittet, the startpath would be the default windows path, usually my documents[/COLOR][COLOR=#ff0000]
    .Show [/COLOR][COLOR=#008000]'Show dialog[/COLOR][COLOR=#ff0000]
    If .SelectedItems.Count = 0 Then Exit Sub [/COLOR][COLOR=#008000]'If pressed Cancel[/COLOR][COLOR=#ff0000]
    FolderPath = .SelectedItems(1) [/COLOR][COLOR=#008000]'Put selected folder path in a variable[/COLOR][COLOR=#ff0000]
    If Not Right(FolderPath, 1) = "\" Then FolderPath = FolderPath & "\" [/COLOR][COLOR=#008000]'Just making sure there is a "\" in the end of the pathname[/COLOR][COLOR=#ff0000]
End With[/COLOR]

'In case of unexpected errors
On Error GoTo ErrHandler
rw = 2
'Loop for whole range (all classes) loops until "blank" cell is reached
Do While Not Range("A" & rw).Value = ""
    'Put class name in a variable
    strClass = Range("A" & rw).Value
    'Loop for current class
    Do While Range("A" & rw).Value = strClass
        'Put login in a variable
        strLogin = Range("B" & rw).Value
        If strLogin = "" Then
            'Delete rows in which the login cell is empty
            Range("A" & rw).EntireRow.Delete xlShiftUp
        Else
            'Filling out the email Column with the login in front of "@school.com"
            Range("E" & rw).Value = strLogin & "@school.com"
            'Copying the login Column to the student as well as the password Column.
            Range("F" & rw).Value = strLogin
            Range("G" & rw).Value = strLogin
            'Filling out the role Column with "STUDENT" in every entry.
            Range("H" & rw).Value = "STUDENT"
            rw = rw + 1
        End If
    Loop
    rw = rw - 1
    'Check if at least one row had a login (if not, all would have been deleted and Range("A" & rw).Value would be "login")
    If Range("A" & rw).Value = strClass Then
        'Copy range for current class, add a new temporary workbook and paste
        Range("A1:H" & rw).Copy
        Workbooks.Add
        ActiveSheet.Paste
        'Disable popup if csv file already exists. Overwrite file (delete codeline if you want popups)
        Application.DisplayAlerts = False
        'Save CSV file. IMPORTANT! Change path to where you want csv files to be saved to
        [COLOR=#008000]'Just replaced the hardcoded path with the variable (FolderPath) holding the selected path[/COLOR]
        ActiveWorkbook.SaveAs Filename:= _
            [COLOR=#ff0000]FolderPath [/COLOR]& strClass & ".[COLOR=#0000ff]txt[/COLOR]", _
            FileFormat:=[COLOR=#0000ff]xlTextWindows[/COLOR], CreateBackup:=False
        'Turn popup warnings back on
        Application.DisplayAlerts = True
        'Close temporary file (without saving)
        ActiveWorkbook.Close False
        'Reactivate this workbook
        ThisWorkbook.Activate
        'Delete range for current class, for next class to be processed
        Range("A2:H" & rw).Delete xlShiftUp
    End If
    rw = 2
Loop
Exit Sub
ErrHandler:
MsgBox "Something went wrong! I'm not so happy now... Aborting" & vbCrLf & _
       vbCrLf & _
       "Error number: " & Err.Number & vbCrLf & _
       "Error description: " & Err.Description, vbCritical
End Sub

By the way, when changing the fileformat to f. ex. .txt, its good practice to also change the FileFormat enumeration:

FileFormat:=[COLOR=#0000ff]xlCSV[/COLOR]
to:
FileFormat:=[COLOR=#0000ff]xlTextWindows[/COLOR]

There is a full list of FileFormat enumerations here: https://msdn.microsoft.com/en-us/library/office/ff198017.aspx

 

[erik11]

Thanks BQardi. The dialog comes in handy, although it is also fine just to change the VBA code itself. Your second suggestion replacing FileFormat := xlCSV with FileFormat := xlTextWindows does not work properly, though, so I changed it back to the old one. It turned out that I had a slightly different situation than the one described above. I was able to easily make the necessary and minor corrections, so it adapted to my new situation. You saved me for a lot of work! First rate help here at MrExcel, indeed!!

Regards,

Erik