Solved

Excel Sublist Generation

Posted on 2014-03-03
2
235 Views
Last Modified: 2014-03-04
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
Comment
Question by:cyber-33
2 Comments
 
LVL 21

Accepted Solution

by:
Ejgil Hedegaard earned 500 total points
ID: 39904190
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
 

Author Comment

by:cyber-33
ID: 39904419
Thank you!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Formula 6 46
Access Excel export not behaving 2 25
Excel Copy Macro down foe each row 4 19
excel help 4 18
PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
This article will show you how to use shortcut menus in the Access run-time environment.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now