macro to sort/create smaller excel files

[tozwp]

Version: Excel 2000

I'm rather inexperienced with Excel and this may be an easy question for someone. I've got a large spreadsheet (roughly 100 wide by 3300 down) that contains data for about 90 items. The separate item descriptions are in the first column with the data then arranged by date for each item. What I'd like to do is to open up this file, run a macro that sorts the data by item (first column) and then exports this as a separate file using the name of the item from the first column. The data in question is the Commitment of Traders data found here: http://www.cftc.gov/cftc/cftccotreports.htm and is the comma delimited data, short form near the bottom of the link.

Getting this data separated into separate files is only the first step in a longer process to analyze this information. So far I'm stuck at this point and if I can get past this, I may have more 'easy' questions. Thanks for any help anyone can provide - hoping to speed up my learning curve here.

 

[hatman]

Well, you can approach this one of two ways: parse the data from the text fiile directly and spawn new sheets of workbooks on the fly writing the data to each location as it is encountered, or import the text file to an excel sheet, and parse THAT data, spawning new books/sheets at the end, and writing the data as the last step.

Each approach has it's pros and cons. Some time back, I wrote a macro for someone who wanted to spawn a new file for each scholastic advisor based on a single master sheet that had little rhyme or reason to it. I used the second option from above... and what follows is the exact macro that I finally built for him. Perhaps you can adapt this for your use... or maybe it is completely inappropriate... but at least you get to see one approach that has worked for someone else on a similar situation:

Sub Macro2()


'define a dynamic String array to hold the names and rows where those names occur
Dim names() As String

'capture the name of the current workbook
wbk1 = ActiveWorkbook.Name

'initialize the array dimension at 2x1
ReDim names(1, 0)

'we know that the first entry on row 2 is unique, so we automatically populate the first
'entry in the array with the first name, and the row on which it occurs (in this case the second)
names(0, 0) = Range("f2").Value
names(1, 0) = "2:2"

'initialize our row counter
cnt1 = 3

'begin a loop, and continue looping as long as the first cell in row number cnt1 is not blank
Do While Cells(cnt1, 1).Value <> ""

    'loop through our array of stored names
    For cnt2 = 0 To UBound(names, 2)
        
        'if the name on the current row of the sheet matches an entry in our name array...
        If names(0, cnt2) = Range("f" & cnt1).Value Then
            
            'then we add the current row number to the name array
            names(1, cnt2) = names(1, cnt2) & "," & cnt1 & ":" & cnt1
            
            'and we stop looking through the name array
            Exit For
        
        End If
    
    'move to the next member of the name array
    Next cnt2
    
    'if we looped though the entire name array and did not find a match (hence counter is greater
    'than the number of member in the name array)...
    If cnt2 > UBound(names, 2) Then
    
        'then we redimension the array to have one more memebr in the second dimension, the preserve
        'command instructs the routine not to clear the data that has already been acquired
        ReDim Preserve names(1, UBound(names, 2) + 1)
        
        'now we add the name and row number to the new member of the name array
        names(0, cnt2) = Range("f" & cnt1).Value
        names(1, cnt2) = cnt1 & ":" & cnt1
        
    End If
    
    'increment the counter to the next row number of the sheet
    cnt1 = cnt1 + 1

Loop

'once we get here, we have collected all data from the sheet, and it is all stored
'in the name array.

'turn off the screen updtating to help speed up the process
Application.ScreenUpdating = False

'loop through the name array for every single member
For cnt = 0 To UBound(names, 2)

    'select all of the rows with the name of the current memeber of the names array
    Range("1:1").Copy
    
    'copy the selected range to the clipboard
'    Selection.Copy

    'add a new workbook
    Workbooks.Add
    
    'capture the name of the new workbook
    wbk2 = ActiveWorkbook.Name

    'the newly added workbook is now active, so we paste from the clipboard to the activesheet
    ActiveSheet.Paste
    
    'initialize counter for destination rows in new workbook.. since we already
    'pasted to row 1, start at row 2
    cnt2 = 2
    
    'find the location of the first comma (delimiter) in the list of rows
    comma = InStr(1, names(1, cnt), ",")
    
    'continue looping through the text string of rows until there are no more commas
    Do While comma > 0
    
        'build the text string for the destination row, from the counter
        drow = cnt2 & ":" & cnt2
    
        'build the text string for the next source row from the text string of all rows we collected on the master sheet
        srow = Left(names(1, cnt), comma - 1)
        
        'delete the current source row from the text string of
        names(1, cnt) = Right(names(1, cnt), Len(names(1, cnt)) - comma)
        
        'activate the master workbook
        Workbooks(wbk1).Activate
        
        'copy the source row
        Range(srow).Copy
        
        'activate the new workbook
        Workbooks(wbk2).Activate
        
        'past ethe data
        Range(drow).PasteSpecial xlPasteAll
        
        'incremet the counter of the destination rows
        cnt2 = cnt2 + 1
        
        'get the location of the next comma in the text string of rows
        comma = InStr(1, names(1, cnt), ",")
        
    Loop
    
    'copy and paste the data for the final entry in the text string of rows
    drow = cnt2 & ":" & cnt2
    srow = names(1, cnt)
    Workbooks(wbk1).Activate
    Range(srow).Copy
    Workbooks(wbk2).Activate
    Range(drow).PasteSpecial xlPasteAll

    'select the entire active sheet
    Cells.Select

    'autosize the column widths of the sheet to fit all of the data
    Cells.EntireColumn.AutoFit
    
    'select cell a1, so when the user opens the new book the next time the whole sheet is not selected
    Range("a1").Select

'    save this new workbook to a certain path with a certain password
'    ActiveWorkbook.SaveAs Filename:= _
'    "C:\Documents and Settings\mnewcomb\Desktop\Subfiles\" & names(0, cnt) & ".xls", FileFormat:= _
'    xlNormal, Password:=Range("g2"), _
'    ReadOnlyRecommended:=False, CreateBackup:=False

    ActiveWorkbook.SaveAs Filename:= _
    "C:\Subfiles\" & names(0, cnt) & ".xls", FileFormat:= _
    xlNormal, Password:=Range("g2"), _
    ReadOnlyRecommended:=False, CreateBackup:=False


    'close the new Workbook
    ActiveWorkbook.Close
    
    'moove along to the next member of the names array

Next cnt

'turn the screen updating back on
Application.ScreenUpdating = True

'tell the user that the process is done
mb = MsgBox("Process COmplete!", , "Done")


End Sub

 

[tozwp]

Thanks much for your input/help - I really appreciate it! There is a third approach here..... hire an expert! I'll either have to learn VB or take that route. I'm more interested in learning how to do this myself so your program will certainly help me out. Thanks again.