Automated File Creation (Excel 97)

Topic

New Reply

I have a number of Spreadsheets that are in the format of one variable per column and a variable number of rows per variable. What I want to do is save each column with a unique name incorporating the contents of Cell AA:1, which will contain a string such as “Lot 55 25.97mm” with date appended and unique identifier A-Z so that file name will be “Contents of AA:1 +DATE + Identifier.TXT” so that each column is stored as a Tab Delimited text file in the same directory as the original file. Any help would be appreciated.

Reply | Quote

Replies

A couple of questions. If you are saving each column in a separate file, then there will only be one entry in each row. Therefore, there will be nothing to tab delimit. Do you really want a tab delimited file, or do you just want a text file, or do you want to transpose the column into a row and have a tab delimited file with one line? If you want to transpose the column into a row, what should happen if there are more than 256 rows in a column?

The code below will save each column as a text file named as you described if that is what you want.

Public Sub SaveCols()
Dim I As Long
Dim oNewWB As Workbook, oOldWB As Workbook
Dim strFileName As String
    Application.ScreenUpdating = False
    Set oOldWB = ActiveWorkbook
    For I = 1 To 26
        Set oNewWB = Workbooks.Add
        oOldWB.Activate
        ActiveSheet.Columns(1).EntireColumn.Copy
        oNewWB.Worksheets("Sheet1").Paste Destination:=oNewWB.Worksheets("Sheet1").Range("A1")
        Application.CutCopyMode = False
        strFileName = ActiveSheet.Range("AA1").Value
        strFileName = strFileName & " " & Format(Date, "yyyymmdd")
        strFileName = strFileName & " " & Left(ActiveSheet.Columns(I).EntireColumn.Address(False, False), 1)
        Application.DisplayAlerts = False
        oNewWB.SaveAs Filename:=oOldWB.Path & "" & strFileName, FileFormat:=xlTextMSDOS
        oNewWB.Close
        Application.DisplayAlerts = True
        Set oNewWB = Nothing
    Next I
    Application.ScreenUpdating = True
End Sub

Reply | Quote

I seem to have gotten the Macro to Run, but it seems only to create 26 individual files all containing the contents of Column A.

What I need is the contents of each column, which can contain any number of datapoints, to be copied to individual Files. Copying should cease once a blank column or column Z is reached. File
naming seemed to work as I needed.

Thanks for your assistance.

Reply | Quote

Replace

        ActiveSheet.Columns(1).EntireColumn.Copy

by

        ActiveSheet.Columns(I).EntireColumn.Copy

This will export column A through Z. It doesn’t test whether a column is blank. Should every cell be tested, or is it enough to test a single cell in each column?

Reply | Quote

Your modification does create 26 text files as it should.

I would like for Macro to check for an Entry in first row of column. If it is blank, that is end of data and no more files need be created and Macro should be exited.

Thanks

Reply | Quote

Immediately below the line For I = 1 To 26, insert the following:

If ActiveSheet.Cells(1, I) = "" Then Exit For

This will test the first cell in the column, and if it is blank, exit the For … Next loop, so that execution continues at Application.ScreenUpdating = True.

Reply | Quote

Inserting suggested code by pasting it into VBA code works just fine. However, trying to type in the change always resulted in a Compile Error.

The good news is that the Macro allows me to automate a process that had been done step by step previously.

Thanks for the assistance.

Reply | Quote

Inserting suggested code by pasting it into VBA code works just fine. However, trying to type in the change always resulted in a Compile Error.

The good news is that the Macro allows me to automate a process that had been done step by step previously.

Thanks for the assistance.

Reply | Quote

Immediately below the line For I = 1 To 26, insert the following:

If ActiveSheet.Cells(1, I) = "" Then Exit For

This will test the first cell in the column, and if it is blank, exit the For … Next loop, so that execution continues at Application.ScreenUpdating = True.

Reply | Quote

Your modification does create 26 text files as it should.

I would like for Macro to check for an Entry in first row of column. If it is blank, that is end of data and no more files need be created and Macro should be exited.

Thanks

Reply | Quote

Replace

        ActiveSheet.Columns(1).EntireColumn.Copy

by

        ActiveSheet.Columns(I).EntireColumn.Copy

This will export column A through Z. It doesn’t test whether a column is blank. Should every cell be tested, or is it enough to test a single cell in each column?

Reply | Quote

I seem to have gotten the Macro to Run, but it seems only to create 26 individual files all containing the contents of Column A.

What I need is the contents of each column, which can contain any number of datapoints, to be copied to individual Files. Copying should cease once a blank column or column Z is reached. File
naming seemed to work as I needed.

Thanks for your assistance.

Reply | Quote

A couple of questions. If you are saving each column in a separate file, then there will only be one entry in each row. Therefore, there will be nothing to tab delimit. Do you really want a tab delimited file, or do you just want a text file, or do you want to transpose the column into a row and have a tab delimited file with one line? If you want to transpose the column into a row, what should happen if there are more than 256 rows in a column?

The code below will save each column as a text file named as you described if that is what you want.

Public Sub SaveCols()
Dim I As Long
Dim oNewWB As Workbook, oOldWB As Workbook
Dim strFileName As String
    Application.ScreenUpdating = False
    Set oOldWB = ActiveWorkbook
    For I = 1 To 26
        Set oNewWB = Workbooks.Add
        oOldWB.Activate
        ActiveSheet.Columns(1).EntireColumn.Copy
        oNewWB.Worksheets("Sheet1").Paste Destination:=oNewWB.Worksheets("Sheet1").Range("A1")
        Application.CutCopyMode = False
        strFileName = ActiveSheet.Range("AA1").Value
        strFileName = strFileName & " " & Format(Date, "yyyymmdd")
        strFileName = strFileName & " " & Left(ActiveSheet.Columns(I).EntireColumn.Address(False, False), 1)
        Application.DisplayAlerts = False
        oNewWB.SaveAs Filename:=oOldWB.Path & "" & strFileName, FileFormat:=xlTextMSDOS
        oNewWB.Close
        Application.DisplayAlerts = True
        Set oNewWB = Nothing
    Next I
    Application.ScreenUpdating = True
End Sub

Reply | Quote