Macro based on header search

Originally Posted by Leith Ross

Hello cardinalsfan0510,

Are these converted files still Excel workbooks or text files?

The files we open to modify are text files, pipe delimited. We then QA the data there and make any changes needed and run the macro shown previously to save it as a pipe delimited file again.

But when we edit the data and run the macro, it is open as a workbook.

EDIT: Here is what I have now. I think it is close. I got rid of a few things and simplified others. I made it only look at the open sheet (will only have one sheet open at a time) and changed the range to check only the first row as far as I need it to go. It will run without errors but will not save the file and the formats for the columns in question do not change.

Again, thanks for the help. I am sure i am just missing something small. I can upload a copy of the file I am testing with if that will help.

Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Cell As Range
Dim Ext As String
Dim Filename As String
Dim Filepath As String
Dim Rng As Range
Dim Wkb As Workbook
Dim Wks As Worksheet

Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile


Do While Not IsEmpty(ActiveCell)
  Set Rng = ActiveSheet.Range.Cells(A1, GW1)
       For Each Cell In Rng
            If LCase(Cell) Like "*zip4*" Then
            Cell.EntireColumn.Cells.NumberFormat = "0000"
            Else
            If LCase(Cell) Like "*zip*" Then
            Cell.EntireColumn.Cells.NumberFormat = "00000"
       End If
       End If
       Next Cell
Loop

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

Open FName For Output Access Write As #FNum

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = ""
        Else
           CellValue = Cells(RowNdx, ColNdx).text
        End If
        CellValue = Replace(CellValue, vbCrLf, "")
        CellValue = Replace(CellValue, vbCr, "")
        CellValue = Replace(CellValue, vbLf, "")
        'CellValue = UCase(CellValue) (This was causing the upper case issue for .jpg)
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine

Next RowNdx

EndMacro:

On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub

Public Sub DoTheExport()

Dim FName As Variant
Dim Sep As String

FName = Application.GetSaveAsFilename()
If FName = False Then
    MsgBox "You didn't select a file"
    Exit Sub
End If
Sep = InputBox("Enter a single delimiter character (e.g., comma or semi-colon)", "Export To Text File")
ExportToTextFile CStr(FName), Sep, MsgBox("Do You Want To Export The Entire Worksheet?", vbYesNo, "Export To Text File") = vbNo

End Sub