Hi All,

I use a code in VBA that will extract text from an excel worksheet.
I use the UsedRange option to get the row and colums with text.
Recently I had a worksheet that had 14434 rows of which maybe 20 were
with text.
The code kept cycling until it reached row 14434.
Is there a way to get only the lines with text?

Public Function Excel2Text(sInputFile As String, sOutputFile As
String, Sep As String)

'Sep:=";"
Dim oAppl As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oSh As Object
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 sTempName As String

On Error GoTo EndFunction:
Set oAppl = New Excel.Application
Set oWorkbook = oAppl.Workbooks.Open(Tempdir & sInputFile, False,
True)

oAppl.Visible = False
oAppl.ScreenUpdating = False
FNum = FreeFile

sTempName = Mid$(sOutputFile, 1, InstrRev(sOutputFile, ".", -1)) &
"TXT"
Open geheugen.gTempDirZoekWoorden & sTempName For Output Access Write
As #FNum

For Each oSh In oWorkbook.Sheets

With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

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).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
Next

EndFunction:
On Error GoTo 0

Close #FNum

oAppl.Quit
Set oWorkbook = Nothing

End Function


Regards
Marco

Since it's your data, maybe you can use something besides the .usedrange
property.

For instance, if you know that every row that is used has something in column A
and every column that is used has something in row 1, you could use:

dim myRng as range
dim LastRow as long
dim LastCol as long

with activesheet
lastrow = .cells(.rows.count,"A").end(xlup).row
lastcol = .cells(1,.columns.count).end(xltoleft).column
set myrng = .range("a1", .cells(lastrow, lastcol))
end with

Then this line:
With ActiveSheet.UsedRange
becomes
with myrng



Co wrote:

Hi All,

I use a code in VBA that will extract text from an excel worksheet.
I use the UsedRange option to get the row and colums with text.
Recently I had a worksheet that had 14434 rows of which maybe 20 were
with text.
The code kept cycling until it reached row 14434.
Is there a way to get only the lines with text?

Public Function Excel2Text(sInputFile As String, sOutputFile As
String, Sep As String)

'Sep:=";"
Dim oAppl As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oSh As Object
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 sTempName As String

On Error GoTo EndFunction:
Set oAppl = New Excel.Application
Set oWorkbook = oAppl.Workbooks.Open(Tempdir & sInputFile, False,
True)

oAppl.Visible = False
oAppl.ScreenUpdating = False
FNum = FreeFile

sTempName = Mid$(sOutputFile, 1, InstrRev(sOutputFile, ".", -1)) &
"TXT"
Open geheugen.gTempDirZoekWoorden & sTempName For Output Access Write
As #FNum

For Each oSh In oWorkbook.Sheets

With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

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).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
Next

EndFunction:
On Error GoTo 0

Close #FNum

oAppl.Quit
Set oWorkbook = Nothing

End Function

Regards
Marco

--

Dave Peterson

ps.

It might be enough to reset the lastused cell first.

Debra Dalgleish shares a few ways he
http://contextures.com/xlfaqApp.html#Unused

(If I knew my data, I still would use something besides .usedrange, though.)

Co wrote:

Hi All,

I use a code in VBA that will extract text from an excel worksheet.
I use the UsedRange option to get the row and colums with text.
Recently I had a worksheet that had 14434 rows of which maybe 20 were
with text.
The code kept cycling until it reached row 14434.
Is there a way to get only the lines with text?

Public Function Excel2Text(sInputFile As String, sOutputFile As
String, Sep As String)

'Sep:=";"
Dim oAppl As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oSh As Object
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 sTempName As String

On Error GoTo EndFunction:
Set oAppl = New Excel.Application
Set oWorkbook = oAppl.Workbooks.Open(Tempdir & sInputFile, False,
True)

oAppl.Visible = False
oAppl.ScreenUpdating = False
FNum = FreeFile

sTempName = Mid$(sOutputFile, 1, InstrRev(sOutputFile, ".", -1)) &
"TXT"
Open geheugen.gTempDirZoekWoorden & sTempName For Output Access Write
As #FNum

For Each oSh In oWorkbook.Sheets

With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

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).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
Next

EndFunction:
On Error GoTo 0

Close #FNum

oAppl.Quit
Set oWorkbook = Nothing

End Function

Regards
Marco

--

Dave Peterson

On 30 Mrz., 14:24, Co wrote:
Hi All,

I use a code in VBA that will extract text from an excel worksheet.
I use the UsedRange option to get the row and colums with text.
Recently I had a worksheet that had 14434 rows of which maybe 20 were
with text.
The code kept cycling until it reached row 14434.
Is there a way to get only the lines with text?

hi Marco,
maybe you could use SpecialCells.

col = 1
Set CellsUsed = Columns(col).SpecialCells(xlCellTypeConstants)
For Each r In CellsUsed
'For ColNdx = StartCol To EndCol
MsgBox Cells(r.Row, col)
'next
Next

if you have text in A1, A100 and A1000,
For each r cycles from 1 to 3.

some limitations:
a cell must contain text, not a formula (see VBA help for
SpecialCells)
if there`s a text in a row, the first column must have a text

stefan