Need to create unique .txt files from selected number of rows

eq52515

New Member
Joined
Jul 24, 2013
Messages
27
Please excuse the long post.

My task is to create unique txt files from a selected number of rows of data. I later import a txt file into a pdf form and print the completed form. If I have 15 rows of data selected, I would need to have 15 unique txt files saved in a specified location.

This is sample of the data:
Storage BinProductVendor BatchOwnerCodeBatchQuantityStorage TypeProduct Short DescriptionUoMInspection DateDoMDoE
50340AAAHHAHHAA015365416ABD09E0020954302JJ9-444777370ECDEOVERBOOT,LIGHTWEIGHPR5/30/20195/1/20095/1/2014

<tbody>
</tbody>

I currently have a macro to do this for a single line of data, but I need to modify for multiple lines. The single line macro names the txt file by combining the first 13 characters of the Prod description and the first 14 of the vendor batch, this was fine until I have multiples of the same info, only in different locations. I believe that CONCATENTATE has a 30 char limit or I could add on to the end of the file name.

There is a lot of formatting going on, and not the cleanest in the world, but most of this is self taught.
This is my current macro:

Code:
Sub Bldg_Tags()
'
' Bldg_Tag Macro
'
'
    
'    ActiveSheet.Name = Range("C5").Value
    
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Paste
        
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Condition Code"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Inspection Activity"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Item Description"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Lot Number"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "NSN or Part Number"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Next Inspection Due / Overage Date"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Quantity"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Unit of Issue"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Remarks"
    Range("A2").Select
    ActiveSheet.Previous.Select
    Range("H3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "MMQ"
    Range("C2").Select
    ActiveSheet.Previous.Select
    Range("M3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D2").Select
    ActiveSheet.Previous.Select
    Range("F3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E2").Select
    ActiveSheet.Previous.Select
    Range("E3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F2").Select
    ActiveSheet.Previous.Select
    Range("O3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Paste
    
    Range("F2").Select
    Selection.NumberFormat = "mmm-yyyy"
    
    Range("G2").Select
    ActiveSheet.Previous.Select
    Range("J3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H2").Select
    ActiveSheet.Previous.Select
    Range("N3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D6").Select
    ActiveCell.FormulaR1C1 = "=LEFT(R[-4]C[-1],13)"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "=LEFT(R[-4]C[-1],14)"
    Range("D8:E8").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-2]C,"" - "",R[-2]C[1])"

    ActiveSheet.Name = Range("D8").Value
    
    Range("H6").Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("H7").Select
    ActiveSheet.Previous.Select
    Range("B3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("H8").Select
    ActiveSheet.Previous.Select
    Range("C3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("H9").Select
    ActiveSheet.Previous.Select
    Range("D3").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            
    Select Case Range("A2").Value
    Case "A", "B", "C"
        Range("H10").Value = "Visually serviceable material, suitable for storage."
    Case Else
        'Do Nothing
    End Select
    
    Range("H11").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C, "" - "", R[-5]C, "" - "", R[-4]C, "" - "", R[-3]C, R[-2]C)"

    Range("H11").Select
    Selection.Copy
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D4:I11").Select
    Selection.ClearContents
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
        
' Text_File_Save Macro

    Dim promptSheetInfo As String
    Dim selSheetNum As Integer
    Dim i As Integer
    Dim folderPath As String

' if there exists muti sheets, select one to export

    If Application.Worksheets.Count > 2 Then

    promptSheetInfo = "There are " & Application.Worksheets.Count & " sheets.  Please select one to export:" & Chr(13) & Chr(10)

    For Each eachSheet In Application.Worksheets
        i = i + 1
        promptSheetInfo = promptSheetInfo & i & ": " & eachSheet.Name & Chr(13) & Chr(10)

    Next eachSheet

' get the selected one

    selSheetNum = InputBox(prompt:=promptSheetInfo, Title:="Please enter a number ", Default:=3)

' activate the sheet

    Application.Sheets(selSheetNum).Activate

    End If

'get the folder for exporting

    folderPath = "V:\Documents\Materiel Tags\Txt data\"

    WS = ActiveSheet.Name
    
'export to text file

    ActiveWorkbook.SaveAs Filename:=folderPath & WS & ".txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
    
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    ActiveWindow.Close
    Application.DisplayAlerts = True
    
'    ActiveSheet.Previous.Select
'    Range("A1").Select
End Sub

Thanks in advance for any advice/help.
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,215,507
Messages
6,125,212
Members
449,214
Latest member
mr_ordinaryboy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top