VBA: Find column header and reformat (date) values in columns

[fr0z3nfyr]

I have VBA code to perform some actions on data in excel file and then convert all that data into semi-colon separated CSV/text file (code below).

Now, all I want is to add VBA code in the existing macro to find a column header (say, "Application date") and then convert all the dates into YYYY-MM-DD format. The original values in this column don't have a fixed date format.

[B]<code>Public Sub ExportToCsvFile(FName As String, _     Sep As String, SelectionOnly As Boolean, _     AppendDataOnExistingFile As Boolean)  Dim WholeLine As String Dim FNum As Integer Dim RowNdx As Long Dim ColNdx As Integer Dim FirstRow As Long Dim LastRow As Long Dim FirstCol As Integer Dim LastCol As Integer Dim CellValue As String   Application.ScreenUpdating = False On Error GoTo EndMacro: FNum = FreeFile  If SelectionOnly = True Then     With Selection         FirstRow = .Cells(1).Row         FirstCol = .Cells(1).Column         LastRow = .Cells(.Cells.Count).Row         LastCol = .Cells(.Cells.Count).Column     End With Else     With ActiveSheet.UsedRange         FirstRow = .Cells(1).Row         FirstCol = .Cells(1).Column         LastRow = .Cells(.Cells.Count).Row         LastCol = .Cells(.Cells.Count).Column     End With End If  If AppendDataOnExistingFile = True Then     Open FName For Append Access Write As #FNum Else     Open FName For Output Access Write As #FNum End If  For RowNdx = FirstRow To LastRow     WholeLine = ""     For ColNdx = FirstCol To LastCol         If Cells(RowNdx, ColNdx).Value = "" Then             CellValue = Chr(34) & Chr(34)         Else            CellValue = Cells(RowNdx, ColNdx).Value            CellValue = Replace(Replace(CellValue, Chr(150), Chr(45)), Chr(151), Chr(45))            CellValue = Replace(Replace(CellValue, Chr(60), Chr(60) & Chr(32)), Chr(10), "
")            CellValue = Chr(34) & Replace(CellValue, Chr(34), Chr(34) & Chr(34)) & Chr(34)         End If         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  Sub ExportToSemiColonCsv()     Dim FileName As Variant     Dim Sep As String     FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="CSV Files (*.csv),*.csv")     If FileName = False Then         Exit Sub     End If      ExportToCsvFile FName:=CStr(FileName), Sep:=";", _        SelectionOnly:=False, AppendDataOnExistingFile:=True End Sub</code>[/B]

 

[BrianMH]

please repost your code. It is unreadable in it's current format

 

[fr0z3nfyr]

Below is my VBA code, I'm sorry i pasted it directly from VB editor and didn't realise that it will be messed up like that.

Public Sub ExportToCsvFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendDataOnExistingFile As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Integer
Dim LastCol As Integer
Dim CellValue As String


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

If SelectionOnly = True Then
    With Selection
        FirstRow = .Cells(1).Row
        FirstCol = .Cells(1).Column
        LastRow = .Cells(.Cells.Count).Row
        LastCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        FirstRow = .Cells(1).Row
        FirstCol = .Cells(1).Column
        LastRow = .Cells(.Cells.Count).Row
        LastCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendDataOnExistingFile = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = FirstRow To LastRow
    WholeLine = ""
    For ColNdx = FirstCol To LastCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Value
           CellValue = Replace(Replace(CellValue, Chr(150), Chr(45)), Chr(151), Chr(45))
           CellValue = Replace(Replace(CellValue, Chr(60), Chr(60) & Chr(32)), Chr(10), "
")
           CellValue = Chr(34) & Replace(CellValue, Chr(34), Chr(34) & Chr(34)) & Chr(34)
        End If
        
        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

Sub ExportToSemiColonCsv()
    Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="CSV Files (*.csv),*.csv")
    If FileName = False Then
        Exit Sub
    End If
    
    ExportToCsvFile FName:=CStr(FileName), Sep:=";", _
       SelectionOnly:=False, AppendDataOnExistingFile:=True
End Sub

 

[fr0z3nfyr]

It's surprising that there are no suggestions, come on community.