VBA - Saving multiple rows as separate txt files

[eq52515]

I currently have a functioning macro that once I select a row in Excel, it will copy information to a new sheet and save as a txt file to be imported into a pdf later. In a separate macro, I sort the building, add a sheet and format it ready to run this macro.

#1 Is it possible to select multiple rows and have each saved as a separate txt file?
#2 Occasionally, I may have already saved the txt file before. How can I add a msg box or something that would ask if I would like to rename the txt file I am trying to save?

Please excuse the additional rem statements, I'm always trying to tweak as needed.

Any and all help is very much appreciated.

Sub Bldg_Tags()
'
' Bldg_Tag Macro
'
'
    
    Application.ScreenUpdating = False
    'Application.ScreenUpdating = True
    ActiveWorkbook.Save
    
    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("A3").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-13],5)"
    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("H10").Select
'    ActiveCell.FormulaR1C1 = "Visually serviceable material, suitable for storage."
            
    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
        
'    ActiveSheet.Previous.Select
'    ActiveWorkbook.Save
'    ActiveSheet.Next.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

 

[eq52515]

Any thoughts on either question 1 or 2?

 

[Joe4]

For question 1, see: Loop through each row of a range in Excel - Stack Overflow

For question 2, see: https://www.mrexcel.com/forum/excel...rqriting-files-visual-basic-applications.html

 

[eq52515]

Thanks Joe4, I'll look into that.