Macro To Create A .txt File

[excelnube]

Hi,

I'm trying to create a .txt file from the data in my spreadsheet.

Requirements:

1) Copy columns A C D J S
2) Where the value in Column S = Out Of Stock
3) Each column to be separated by **
4) Each row to be separated by *split*
5) Remove *split* from the last record

Example of output file:

A**C**D**J**S*split*
0001**3**01-12-2012**Refund sent**Out of Stock*split*
0002**4**02-12-2012**Sent for fabrication**Out of Stock*split*
0003**4**03-12-2012**All items in red**Out of Stock*split*
0004**1**28-11-2012**Deliver on Mondays only**Out of Stock

My code so far:

Sub Create_OutOfStocktxt_File()
    Dim fs As Object, a As Object, i As Integer, z As String, t As String, l As String, mn As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("C:\\OutOfStock.txt", True)
    Dim r As Long
    Dim c As Long
    Dim Cols
    
    Cols = Split("A C D J S")
    
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        z = ""
    For c = 0 To UBound(Cols)
        z = z & Cells(r, Cols(c)) & "*Split*"
    Next c
        a.writeline z
    Next r
    
End Sub

Any help appreciated.

Thanks

 

[hippiehacker]

i would try like this

Sub Create_OutOfStocktxt_File()
    Dim fs As Object, a As Object, i As Integer, z As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("C:\temp\OutOfStock.txt", True)
    Dim lastrow As Long
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
     For i = 1 To lastrow
      If i <> lastrow Then
       z = Range("A" & i).Value & "**" & Range("C" & i).Value & "**" & Range("D" & i).Value & "**" & Range("J" & i).Value & "**" & Range("S" & i).Value & "*split*"
      Else
      z = Range("A" & i).Value & "**" & Range("C" & i).Value & "**" & Range("D" & i).Value & "**" & Range("J" & i).Value & "**" & Range("S" & i).Value
      End If
    
        a.writeline z
    Next i
    
End Sub

 

[Andrew Poulsom]

This will save the text file on your Desktop:

Sub Create_OutOfStocktxt_File()
    Dim fs As Object
    Dim a As Object
    Dim Cols As Variant
    Dim r As Long
    Dim z As String
    Dim c As Long
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile(CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "OutOfStock.txt", True)
    Cols = Split("A C D J S")
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Range("S" & r).Value = "Out of Stock" Then
            z = ""
            For c = LBound(Cols) To UBound(Cols)
                z = z & "**" & Cells(r, Cols(c)).Text
            Next c
            z = z & "*Split*"
            a.writeline z
        End If
    Next r
End Sub

 

[excelnube]

Sub Create_OutOfStocktxt_File()
    Dim fs As Object
    Dim a As Object
    Dim Cols As Variant
    Dim r As Long
    Dim z As String
    Dim c As Long
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("c:\\OutOfStock.txt", True)
    Cols = Split("A C D J S")
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Range("S" & r).Value = "Out of Stock" Then
            z = ""
            For c = LBound(Cols) To UBound(Cols)
                z = z & "**" & Cells(r, Cols(c)).Text
            Next c
            z = z & "*Split*"
            a.writeline z
        End If
    Next r
End Sub

Thanks, im receiving a debug error at line:

If Range("S" & r).Value = "Out of Stock" Then

 

[Andrew Poulsom]

Did you try the code I posted?

 

[excelnube]

Did you try the code I posted?

Yup, the code nearly works...

Although it is creating a file with the expected data and separating columns with ** and rows with *split*, i am receiving a debug error at line:

If Range("S" & r).Value = "Out of Stock" Then

Error over hovering over 'Range' is: Range("S" & r).Value = Error 2015

Additionally, the last record is not removing the last *split* - suspect this because of the debug issue.

 

[Andrew Poulsom]

Why do you have #VALUE! in that cell?

 

[excelnube]

Why do you have #VALUE! in that cell?

Ah, i assume that's causing the issue.

Earlier in my code, i have a formula to place a status in Column S

Range("S2").Resize(lastrow - 1) = "=IF(I2<0.333333333333333,""NearEmpty"", IF(I2= ""Out of Stock"",""Out of Stock"", IF(I2= ""Stock Stop"",""StockStop"",""InStock"")))"

 

[Andrew Poulsom]

So do you have an error in column I?

 

[excelnube]

So do you have an error in column I?

Yup, when a cell is blank/empty..

Is there a way i can put a loop in my code that creates the .txt file to see if Column S contains any #VALUES! and deletes that cells data?

If Range("S" & r).Value = "#VALUE!" Then
   Cell.Value .ClearContents
End If

If Range("S" & r).Value = "Out of Stock" Then
            z = ""
            For c = LBound(Cols) To UBound(Cols)
                z = z & "**" & Cells(r, Cols(c)).Text
            Next c
            z = z & "*Split*"
            a.writeline z
        End If