Excel Sublist Generation

cyber-33 used Ask the Experts™
I need a macro that can scan through an excel document, select subsets of info from this excel document and write this info to separate text files.

Specifically, the excel document looks like this:
Column A: name of the text file
Column C: text
Column D: New doc indication - can be "Y" or blank.

The script should:

1. Create a parameter that indicates the folder location where the newly created files will be written to.

2. Scan through the active spreadsheet, starting from the first row and ending with the last row.

3.  create a new text file every time it encounters a "Y" value in column D of the currently scanned row. The name of the text file should be value stored in column A of the same row.

4.  The context of the text file should be each line stored in Column C starting and including the row that has the "Y" value in row D, and up to and NOT including the either the next occurrence of Y value in Column D, or the end of the spreadsheet. Each line should be written separately - one below another.

For example, scanning of the spreadsheet like the one below should create 3 files A.txt, D.txt and I.txt.:
Name            Text      New Doc
A            IMAGES\001\S-SDF-905-0000001.jpg      Y
B            IMAGES\001\S-SDF-905-0000002.jpg      
C            IMAGES\001\S-SDF-905-0000003.jpg      
D            IMAGES\001\S-SDF-905-0000004.jpg      Y
E            IMAGES\001\S-SDF-905-0000005.jpg      
F            IMAGES\001\S-SDF-905-0000006.jpg      
G            IMAGES\001\S-SDF-905-0000007.jpg      
H            IMAGES\001\S-SDF-905-0000008.jpg      
I            IMAGES\001\S-SDF-905-0000009.jpg      Y
J            IMAGES\001\S-SDF-905-0000010.jpg      
K            IMAGES\001\S-SDF-905-0000011.jpg      
L            IMAGES\001\S-SDF-905-0000012.jpg      

A.txt should contain

And so on.

Thank you for your help!
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Try this, press the button to run the macro.

To print the files (module1)
Sub PrintSubList()
    Dim FolderName As String, txtFileName As String
    Dim ws As Worksheet, rw As Long, NbrFiles As Long
    FolderName = SelectFolder("Select Folder")
    If FolderName = vbNullString Then
        MsgBox "No Folder Selected, Program Stop"
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        txtFileName = ""
        NbrFiles = 0
        For rw = 2 To ws.Range("A1").CurrentRegion.Rows.Count
            If ws.Cells(rw, 3) = "Y" Then
                If txtFileName <> "" Then
                    Close #1
                End If
                txtFileName = ws.Cells(rw, 1) + ".txt"
                NbrFiles = NbrFiles + 1
                Open FolderName + "\" + txtFileName For Output As #1
                Print #1, ws.Cells(rw, 2)
            ElseIf txtFileName <> "" Then
                Print #1, ws.Cells(rw, 2)
            End If
        Next rw
        If txtFileName <> "" Then
            Close #1
        End If
        MsgBox Trim(Str(NbrFiles)) + " files created in folder " + Chr(10) + FolderName
    End If
End Sub

Open in new window

To select the folder for the files (module2)
Function SelectFolder(Title As String, _
        Optional InitialFolder As String = vbNullString, _
        Optional InitialView As Office.MsoFileDialogView = _
            msoFileDialogViewList) As String
    Dim V As Variant
    Dim InitFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Title
        .InitialView = InitialView
        If Len(InitialFolder) > 0 Then
            If Dir(InitialFolder, vbDirectory) <> vbNullString Then
                InitFolder = InitialFolder
                If Right(InitFolder, 1) <> "\" Then
                    InitFolder = InitFolder & "\"
                End If
                .InitialFileName = InitFolder
            End If
        End If
        On Error Resume Next
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    SelectFolder = CStr(V)
End Function

Open in new window



Thank you!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial