Change Event Exporting to a text file

[snownut2]

I am trying to export specific cell data to an external text file upon the triggering of a change event. I have the triggering event working fine, and a text file being written, however I only need specific data written, not the entire worksheet. (most of this was from cpearsons website)

What am looking for is as follows;

• Text Filename to be from cell "A" (text in cell)of the event trigger cell row.
• Contents of cells "D" (text in cell), "F" (number in cell) and the current date, all written on one line appended to the end of the file.

So far I have the following code;

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    Range("I1").Value = Date
    Application.EnableEvents = True
    
If Target.Column > 5 And Target.Column < 7 Then
        DoTheExport
        
        Else
        
         
    End If
      
    
End Sub



Sub DoTheExport()
    ExportToTextFile FName:="C:\program files\equipment logs\test.txt", Sep:=";", _
       SelectionOnly:=False, AppendData:=True
End Sub


Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData 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


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

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

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

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Value
        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

Thank you,
Bruce

 

[snownut2]

If it would make it any easier it would be ok if the entire row (from the cell that triggered the event) were appended to the text file, instead of just the 2 cells. I would still need the date there also.

 

[snownut2]

We'll see what happens over the weekend.

 

[John_w]

Try this (it replaces your entire code). You might need to change the date format used in the Format function.

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    'Range("I1").Value = Date
    Application.EnableEvents = True
    
    If Target.Column = 6 Then
        Append_Data Cells(Target.Row, "A").Value, Cells(Target.Row, "D").Value, Cells(Target.Row, "F").Value
    End If
    
End Sub


Private Sub Append_Data(FileName As String, CellD As String, CellF As String)

    Dim fileNum As Integer
    
    Const folder As String = "C:\program files\equipment logs\"
    
    fileNum = FreeFile
    Open folder & FileName For Append Access Write As #fileNum
    Print #fileNum, CellD & CellF & Format(Date, "dd-mm-yyyy")
    Close #fileNum

End Sub

 

[snownut2]

John thank you very much that works perfectly.


Bruce