Improve company productivity with a Business Account.Sign Up

x
?
Solved

Excel Sublist Generation

Posted on 2014-03-03
2
Medium Priority
?
261 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 25

Accepted Solution

by:
Ejgil Hedegaard earned 2000 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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

With the emergence of Office 365 as a superior email communication platform, many organizations have started switching over to it.  After migrating to Office 365, sometimes users, as well as organizations, will have to import PST files to Office 36…
Here is why.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

608 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