Extract data from Excel worksheet using FSO

N M
N M used Ask the Experts™
on
Excel VBA: I need to extract a worksheet, row by row, pipe separated, all non-empty rows.
Currently I am able to select based on UsedRange

Public Sub Data(WorkSheetName)

    With Worksheets(WorkSheetName)
        .UsedRange: .UsedRange.Select
    End With

End Sub

Open in new window


How can I write to a file all non-empty rows (using FSO)?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Ryan ChongSoftware Team Lead

Commented:
How can I write to a file all non-empty rows (using FSO)?

FSO can't read Excel file, you got to use Excel objects to do that instead, use Excel.Application, Excel.Workbook, Excel.Worksheet instead.
N MConsultant

Author

Commented:
Thank you for the comment and the effort.
I am currently executing a Sub in an Excel where i want the extracted data, to make it simpler below is my code and I don't know how to recognise the change of row; otherwise, code works:

Public Sub Data(WorkSheetName)

    Dim xRange As Range
    Dim fso As Object
    Dim oFile As Object
    Dim PathFile
       
        PathFile = frmSettings.TextBox1.Text
            If Right(PathFile, 1) <> "\" Then PathFile = PathFile & "\"
        PathFile = PathFile & Application.ActiveWorkbook.Name & "." & WorkSheetName & ".txt"
    
    With Worksheets(WorkSheetName)
        Set xRange = .UsedRange
        .UsedRange.Select
    End With


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(PathFile)
    
        For Each cell In xRange.Cells
            p = p & cell.Value & frmSettings.ComboBox1.Value
            If >>row changes<<
                oFile.WriteLine p
                p = ""
            End If
        Next
    
        oFile.Close
    
    Set fso = Nothing
    Set oFile = Nothing

End Sub

Open in new window

Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
You may try something like this...

Dim xRange As Range
Dim p As String
Dim lngRow As Long, lngCol As Long
Set xRange = ActiveSheet.UsedRange
For lngRow = 1 To xRange.Rows.Count
    If Application.CountA(xRange.Rows(lngRow)) > 0 Then
        For lngCol = 1 To xRange.Columns.Count
            If xRange.Cells(lngRow, lngCol) <> "" Then
                If p = "" Then
                    p = xRange.Cells(lngRow, lngCol).Value
                Else
                    p = p & frmSettings.ComboBox1.Value & xRange.Cells(lngRow, lngCol).Value
                End If
            End If
        Next lngCol
    End If
    oFile.WriteLine p
    p = ""
Next lngRow

Open in new window

aikimark
Top Expert 2014

Commented:
If you concatenated the row range with a function like my Better Concatenate Function, you could accomplish the following:

1. Specify the pipe character as the inter-cell delimiter
2. Compare two rows with a simple string comparison operation
3. Output the pipe-delimited string if there was a difference
https://www.experts-exchange.com/articles/7811/A-Better-Concatenate-Function.html

Even if you do not use my function, you can do some row/column slicing with the Index() function to get a vector of your values and then use the Join() function on the vector.  A vector is a 1D array.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial