Manipulating an existing Excel file and creating CVS files automatically

E

erik11

New Member
Joined
Apr 30, 2011
Messages
11
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



mrexcelpic3.jpg
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
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.

Code: 
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
 
Upvote 0
This should do what you want:
Code: 
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
 
Upvote 0
BQardi said:
This should do what you want:
Code: 
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
Click to expand...


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

Regards,

Erik
 
Upvote 0
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
 
Upvote 0
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...):
Code: 
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:
Code: 
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
 
Last edited:
Upvote 0
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
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Seperate Data In One Cell Across Multiple Cells
Replies
6
Views
2K
Alex Blakenburg
A
S
  • Question Question
Macro to prep a CSV file - data selection, manipulation, and saving with dynamic name
2
Replies
15
Views
3K
Spiritseeker
S
T
  • Question Question
VBA: Save As Script That the Opens, Tweaks New CSV File
Replies
1
Views
840
LockeGarmin
LockeGarmin
J
  • Question Question
excel VB: Importing muiltiple CSV Files ( Including Dates ) into Excel Help plz
Replies
1
Views
596
John_w
J
L
  • Question Question
How to substitute all comma in this excel file?
Replies
3
Views
874
Harishiyer
H

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top