Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 255
  • Last Modified:

Excel Sublist Generation

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
IMAGES\001\S-SDF-905-0000001.jpg
IMAGES\001\S-SDF-905-0000002.jpg
IMAGES\001\S-SDF-905-0000003.jpg

And so on.

Thank you for your help!
0
cyber-33
Asked:
cyber-33
1 Solution
 
Ejgil HedegaardCommented:
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"
        End
    Else
        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
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    SelectFolder = CStr(V)
End Function

Open in new window

Sublist-txt-files.xlsm
0
 
cyber-33Author Commented:
Thank you!
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now