Exporting select data to a .cvs

[iMAN2]

Hi,

I reallly need any help with this please. Basically I need code which can export certain data from the spreadsheet into a .csv file
I have attached the excel file, which contains some coding and sample data and an example output file. This is the current coding:


Sub Export()
' A list of variables
Dim Stu_getRow As Integer, S_getColumn As Integer
' Reset search variable
Stu_getRow = 4
Open "c:\testout.txt" For Append As #1
' Break both loops once limits exceeded
While Stu_getRow >= 4 And Stu_getRow <= 299
Print #1, Sheet13.Cells(Stu_getRow, 4).Text & " ---" & Sheet13.Cells(Stu_getRow, 5).Text
S_getColumn = 8
While S_getColumn >= 8 And S_getColumn <= 39
If IsNumeric(Sheet13.Cells(Stu_getRow, S_getColumn).Text) = True Then
' Yes input is valid, process it
Print #1, "SUBJECT CODE: " & Sheet2.Cells(S_getColumn - 6, 2) & " " & Sheet13.Cells(3, S_getColumn).Text & ": " & Sheet13.Cells(Stu_getRow, S_getColumn).Text
End If
S_getColumn = S_getColumn + 1
Wend
Stu_getRow = Stu_getRow + 1
Wend
Close #2
End Sub


What is needed

I need to be able to export:

"first name" and "last name" column merged togetherIf last name doesn't exist it should still consider that row as a valid entry.


if a subject, for that person, contains a mark then, export that subject's, "subject code" and the mark. To show there is no mark, the cell will display a "-". If it does this, then the mark, or subject code for that person shouldn't be exported.


If a cell which should have a mark says "check", then return a popup error stating for which name and subject (not subject mark) the cell contains the value "check". However, it should still export any entries that come after this entry, but not including this entry.E.g. For Mary, the subject, English reads "Check". Thus all entries prior to and after Mary should still be exported, but that Mary shouldn't be exported. A popup error saying "Please check entry for Mary. Subject: English" should come up after the export.


Cycle though names from row 4 to 299. - If there is a gap between an entry of the names it should still continue cyling through the entries until row 299, even if they are blank (as there may be a gap between entries and the entries after the gap should not be ignored.E.g. There is a gap between Harry and Jim. The macro should ignore the row with a blank first name between name entries, however still cylce through to row 299.

Cylces through subjects until there is a blank subject (unlike the names), it should stop cylcing when it comes across a blank subject cell.E.g. Stop at "Japanese Continuers"

Current Code:

The "-" which I want to signify as a blank cell for marks are still exported. These should be considered as blank cells and thus not exported.
Currently, if a name or mark is updated and then the macro is run to re-export, the output file doesn't appear to be updated with the new and/or changed data.
Output file:

.csv file
Output file name and worksheet name should be the year, retrieved from the 'year' worksheet. e.g. 2010.csv Formatting of output file:

Column 1: Full name (first name and last name merged together)
Column 2: Subject Code
Column 3: Mark
Column 4: Subject Code
Column 5: Mark
etc.If there are three subjects then there should be 7 columns with data, for that entry (name, 3 marks, 3 subject codes).

If there are four subjects then 9 columns with data for that entry (1 name, 4 marks, 4 subject codes).


Each row is a separate name entry.If in the 'Moderated Marks' sheet there is a gap between entries, then that gap should not be exported as an entry. The entries after that gap, however, should be exported as a continuation of the data before the gap.

Thankyou so much for all your help. Much Appreciated. :beerchug:

[Kenneth Hobs]

That is doable but it is alot to digest.

Not sure what Word file you mean. You attached an xls.

If you can fill in say 5-10 dummy data rows in the xls and manually, make what you expect the txt file to be, that would help us help you more easily.

[iMAN2]

Thread updated. New sample data and output file.

[Kenneth Hobs]

I would not recommend using popup messages. IF there are many, it might take a long time to run the macro. If you must be notified of a problem, have it create an error report or change the interior color. Another macro could make it easier for you to edit specific rows with a set interior color.

When I get time late tomorrow, I will look into helping you get started if no one has helped out by then.

[iMAN2]

Thankyou!! Sure no problems, i'll use conditional formatting to show an error has occurred for that entry. If the cell reads "check", however, is it possible for the script to ignore that row?

Thanks once again Kenneth.

[mdmackillop]

This ignores Check, but not the row.


Option Explicit
Sub Exports()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
ShName = Sheets("YEAR").Range("C2")
Set Sh = Worksheets.Add
Sh.Name = ShName
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
With Sheets("Half-Yearly - Moderated Marks")
For rw = 4 To 299
tCol = 2
nme = .Cells(rw, 4) & " " & .Cells(rw, 5)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 7 To .Cells(3, 7).End(xlToRight).Column
If LCase(.Cells(rw, col)) <> "check" And .Cells(rw, col) <> "-" Then
Sh.Cells(tRw, tCol) = SubCode(col - 6)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col)
tCol = tCol + 2
End If
Next
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
REM Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True
End Sub

[mdmackillop]

Ignore row containing Check


Option Explicit
Sub Exports2()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
Dim c As Range
ShName = Sheets("YEAR").Range("C2")
Set Sh = Worksheets.Add
Sh.Name = ShName
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
With Sheets("Half-Yearly - Moderated Marks")
For rw = 4 To 299
Set c = .Rows(rw).Find("check", MatchCase:=False)
If c Is Nothing Then
tCol = 2
nme = .Cells(rw, 4) & " " & .Cells(rw, 5)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 7 To .Cells(3, 7).End(xlToRight).Column
If .Cells(rw, col) <> "-" Then
Sh.Cells(tRw, tCol) = SubCode(col - 6)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col)
tCol = tCol + 2
End If
Next
End If
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
REM Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True
End Sub

[iMAN2]

Thankyou so much mdmackillop! You are awsome!.

If you don't mind just another thing, is it possible to save the export 2009 sheet in a separate .csv workbook in the same directory as the moderator workbook (containing initial data) as well as how it works currently (saving as a separate sheet within the same workbook)?


Thankyou once again. Cheers.

[iMAN2]

Hmmm if i make change to the data that is to be exported and then reexport i get an error: cannot rename sheet to the same name as another sheet.

Is it possible to make it so that the data is updated in the export. Also can this be done to the export that is made to the new .csv workbook.

Thanks

[mdmackillop]

Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
REM Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True

This section of the code saves the sheet as a csv file in the same folder as the workbook.
ActiveWindow.Close is closing that new file.
If you have no need of the sheet in the file then the line Sh.Delete
will delete it. Remove the REM (Remark) letters to allow this to happen.

[mdmackillop]

Hmmm if i make change to the data that is to be exported and then reexport i get an error: cannot rename sheet to the same name as another sheet.

Is it possible to make it so that the data is updated in the export. Also can this be done to the export that is made to the new .csv workbook.

Thanks

If 2009 is deleted then you can rerun the code. I left it undeleted for checking purposes. The CSV file will be overwritten by the newer version.

[iMAN2]

Is it possible to update the 2009 sheet within the orginal workbook without deleting it first?
Thanks

[iMAN2]

Hmm, when i export it, i cant find the exported .csv workbook... :S

[iMAN2]

my bad sorry, it does so. Verry sorry Thankyou.

[iMAN2]

Is it possible to make the code ignore a row if first name is empty?
ty

[mdmackillop]

Sub Exports2()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
Dim c As Range
Application.ScreenUpdating = False
ShName = Sheets("YEAR").Range("C2")
On Error Resume Next
Set Sh = Worksheets(ShName)
If Sh Is Nothing Then
Set Sh = Sheets.Add
Sh.Name = ShName
Else
Sh.Cells.ClearContents
End If
On Error GoTo 0
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
With Sheets("Half-Yearly - Moderated Marks")
For rw = 4 To 299
Set c = .Rows(rw).Find("check", MatchCase:=False)
'Test for Check and First Name
If c Is Nothing And Not Len(.Cells(rw, 4)) = 0 Then
tCol = 2
nme = .Cells(rw, 4) & " " & .Cells(rw, 5)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 7 To .Cells(3, 7).End(xlToRight).Column
If .Cells(rw, col) <> "-" Then
Sh.Cells(tRw, tCol) = SubCode(col - 6)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col)
tCol = tCol + 2
End If
Next
End If
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[iMAN2]

Thanks for that.

Is it possible to name the exported .csv workbook as the current date and time instead of using the 'year' worksheet.

ty

[mdmackillop]

Adjust as required.

ActiveWorkbook.SaveAs Filename:=Pth & Format(Now, "dd_mmm_yy_hh_ss") & ".csv", FileFormat:=xlCSV

[iMAN2]

Hi, for some reason with the latest code, if one of the marks reads check, that row/entry is still exported. Is there any way to fix this?

ty

[iMAN2]

actually dw, it works, just something wrong with my sheet.

[iMAN2]

sigh, actually the worksheet is fine, something wrong with the code. ill post up an updated sample.

[iMAN2]

Hi again,
Everything works fine except the line for ignoring the 'check' function. In the original example the 'check' was manually typed into the cell. However, in the actual worksheet, the 'check' appears as a link to another cell, and when this happens the export doesn't ignore that row.

Is it possible to fix this?

thanks

[mdmackillop]

Set c = .Rows(rw).Find("check", LookIn:=xlValues, MatchCase:=False)

[iMAN2]

MD is legend.

[iMAN2]

Is it possible to automatically get the exported workbook protected in terms of: protect sheet, workbook, and to open the workbook.

[iMAN2]

Hi,
This is the updated moderator, all features are kept the same, however, the formatting is different, to make it easier to make a form for data entry.

Can you apply the coding to this workbook.

Thankyou

[iMAN2]

This is the final and last format.
Note: In the 'moderated-marks' sheets, the data to be exported is not linked to other cells as it once was (for which the original coding was made). They are just plain values, which need to be exported.

[iMAN2]

MD, when u get some free time could u please have a look.

[mdmackillop]

I'll check it out this evening

[mdmackillop]

Sub Exports2()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
Dim c As Range

Application.ScreenUpdating = False
ShName = Sheets("YEAR").Range("C2")
On Error Resume Next
Set Sh = Worksheets(ShName)
If Sh Is Nothing Then
Set Sh = Sheets.Add
Sh.Name = ShName
Else
Sh.Cells.ClearContents
End If
On Error GoTo 0
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
With Sheets("Trials - Moderated Marks")
.Activate
For rw = 4 To 299
Set c = .Rows(rw).Find("check", MatchCase:=False)
'Test for Check and First Name
If c Is Nothing And Not Len(.Cells(rw, 6)) = 0 Then
tCol = 2
nme = .Cells(rw, 6) & " " & .Cells(rw, 7)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 16 To .Cells(16, 7).End(xlToRight).Column Step 2
If .Cells(rw, col) <> "" Then
Sh.Cells(tRw, tCol) = Range("SubjectList").Find(Cells(rw, col), lookat:=xlWhole).Offset(, 1)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col + 1)
tCol = tCol + 2
End If
Next
End If
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Rem Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[iMAN2]

Thanks Md. To apply this same code to the half-yearly sheet which has less columns, which values would i change in the code? I tried changing to 16's to 10's (different subject starting point) but the export ends up wrong.

Also in the coding, what does SubjectList stand for?

Also is it possible for the export worksheet to be protected in terms of: protect sheet, workbook, and to open the workbook. Password: 123

Thanks

[mdmackillop]

Revised and corrected codes. It appears CSV files cannot be protected as Excel worksheets etc.

Sub Exports3()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
Dim c As Range
Dim SubjectList As Range


Application.ScreenUpdating = False
ShName = Sheets("YEAR").Range("C2")
On Error Resume Next
Set Sh = Worksheets(ShName)
If Sh Is Nothing Then
Set Sh = Sheets.Add
Sh.Name = ShName
Else
Sh.Cells.ClearContents
End If
On Error GoTo 0
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
Set SubjectList = SubCode.Offset(, -1)
End With
With Sheets("Trials - Moderated Marks")
.Activate
For rw = 4 To 299
Set c = .Rows(rw).Find("check", MatchCase:=False)
'Test for Check and First Name
If c Is Nothing And Not Len(.Cells(rw, 6)) = 0 Then
tCol = 2
nme = .Cells(rw, 6) & " " & .Cells(rw, 7)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 16 To .Cells(16, rw).End(xlToRight).Column Step 2
If .Cells(rw, col) <> "" Then
Sh.Cells(tRw, tCol) = SubjectList.Find(.Cells(rw, col), lookat:=xlWhole).Offset(, 1)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col + 1)
tCol = tCol + 2
End If
Next
End If
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Rem Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub




Sub Exports4()
Dim Sh As Worksheet
Dim i As Long
Dim SubCode As Range
Dim tRw As Long, tCol As Long, rw As Long
Dim nme As String
Dim col As Long
Dim k As Long
Dim ShName As String, Pth As String
Dim c As Range
Dim SubjectList As Range


Application.ScreenUpdating = False
ShName = Sheets("YEAR").Range("C2")
On Error Resume Next
Set Sh = Worksheets(ShName)
If Sh Is Nothing Then
Set Sh = Sheets.Add
Sh.Name = ShName
Else
Sh.Cells.ClearContents
End If
On Error GoTo 0
With Sheets("Subject CODE")
Set SubCode = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
Set SubjectList = SubCode.Offset(, -1)
End With
With Sheets("Half-Yearly - Moderated Marks")
.Activate
For rw = 4 To 299
Set c = .Rows(rw).Find("check", MatchCase:=False)
'Test for Check and First Name
If c Is Nothing And Not Len(.Cells(rw, 6)) = 0 Then
tCol = 2
nme = .Cells(rw, 6) & " " & .Cells(rw, 7)
If Len(nme) > 1 Then
tRw = tRw + 1
Sh.Cells(tRw, 1) = nme
For col = 10 To .Cells(rw, 10).End(xlToRight).Column Step 2
If .Cells(rw, col) <> "" Then
Cells(rw, col).Select
Sh.Cells(tRw, tCol) = SubjectList.Find(.Cells(rw, col), lookat:=xlWhole).Offset(, 1)
Sh.Cells(tRw, tCol + 1) = .Cells(rw, col + 1)
tCol = tCol + 2
End If
Next
End If
End If
Next
End With
Application.DisplayAlerts = False
Pth = ActiveWorkbook.Path & "\"
Sh.Copy
ActiveWorkbook.SaveAs Filename:=Pth & ShName & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Rem Sh.Delete 'Remove REM to delete sheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[iMAN2]

MD THANKYOU!!! IT WORKS PERFECTLY. GENIUS! =D