How Do I Modify Pearson's Code to Add "Treat Consecutive Delimiters As One"?

Hello.

I found some really neat code by Chip Pearson
(http://www.cpearson.com/excel/imptext.htm) that enables the user to
specify a filename and delimiter, and then imports that file into an
existing Excel worksheet using the said delimiter.

My problem is that the text files I need to import use VARYING amounts
of spaces as delimiters; therefore, my columns will not align
correctly. I think I can work around this if I could modify Pearson's
code so that it "treats consecutive delimiters as one" (an option that
can be selected in the Import Wizard).

I have very little experience in VBA, so I don't know how to modify it.
Can someone help me?

Thanks,
Alicia


Here is the code "as is":

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub

________________________________________

Since this code has parameters, it will not appear in the standard
"Macros" dialog list (ALT+F8). The following procedure will prompt you
for the filename and delimiter character, and then run the
ImportTextFile procedure.

Public Sub DoTheImport()
Dim FName As Variant
Dim Sep As String

FName = Application.GetOpenFilename _
(filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If

Sep = InputBox("Enter a single delimiter character.", _
"Import Text File")
ImportTextFile CStr(FName), Sep

End Sub

Bit kludgy, but try this

Public Sub ImportFile()
Dim FName As Variant
Dim Sep As String
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim arySeps
Dim i As Long, j As Long, iPrev As Long

FName = Application.GetOpenFilename _
(filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If

arySeps = Array("|", ":", ";")

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

Open FName For Input Access Read As #1

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
iPrev = 1
For i = 1 To Len(WholeLine)
For j = LBound(arySeps) To UBound(arySeps)
If Mid(WholeLine, i, 1) = arySeps(j) Then
Cells(RowNdx, ColNdx).Value = Mid(WholeLine, iPrev, i -
iPrev)
iPrev = i + 1
ColNdx = ColNdx + 1
Exit For
End If
Next j
Next i
Cells(RowNdx, ColNdx).Value = Mid(WholeLine, iPrev, i - iPrev)
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

<[email protected]> wrote in message
news:[email protected]...
> Hello.
>
> I found some really neat code by Chip Pearson
> (http://www.cpearson.com/excel/imptext.htm) that enables the user to
> specify a filename and delimiter, and then imports that file into an
> existing Excel worksheet using the said delimiter.
>
> My problem is that the text files I need to import use VARYING amounts
> of spaces as delimiters; therefore, my columns will not align
> correctly. I think I can work around this if I could modify Pearson's
> code so that it "treats consecutive delimiters as one" (an option that
> can be selected in the Import Wizard).
>
> I have very little experience in VBA, so I don't know how to modify it.
> Can someone help me?
>
> Thanks,
> Alicia
>
>
> Here is the code "as is":
>
> Public Sub ImportTextFile(FName As String, Sep As String)
>
> Dim RowNdx As Integer
> Dim ColNdx As Integer
> Dim TempVal As Variant
> Dim WholeLine As String
> Dim Pos As Integer
> Dim NextPos As Integer
> Dim SaveColNdx As Integer
>
> Application.ScreenUpdating = False
> 'On Error GoTo EndMacro:
>
> SaveColNdx = ActiveCell.Column
> RowNdx = ActiveCell.row
>
> Open FName For Input Access Read As #1
>
> While Not EOF(1)
> Line Input #1, WholeLine
> If Right(WholeLine, 1) <> Sep Then
> WholeLine = WholeLine & Sep
> End If
> ColNdx = SaveColNdx
> Pos = 1
> NextPos = InStr(Pos, WholeLine, Sep)
> While NextPos >= 1
> TempVal = Mid(WholeLine, Pos, NextPos - Pos)
> Cells(RowNdx, ColNdx).Value = TempVal
> Pos = NextPos + 1
> ColNdx = ColNdx + 1
> NextPos = InStr(Pos, WholeLine, Sep)
> Wend
> RowNdx = RowNdx + 1
> Wend
>
> EndMacro:
> On Error GoTo 0
> Application.ScreenUpdating = True
> Close #1
>
> End Sub
>
> ________________________________________
>
> Since this code has parameters, it will not appear in the standard
> "Macros" dialog list (ALT+F8). The following procedure will prompt you
> for the filename and delimiter character, and then run the
> ImportTextFile procedure.
>
> Public Sub DoTheImport()
> Dim FName As Variant
> Dim Sep As String
>
> FName = Application.GetOpenFilename _
> (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
> If FName = False Then
> MsgBox "You didn't select a file"
> Exit Sub
> End If
>
> Sep = InputBox("Enter a single delimiter character.", _
> "Import Text File")
> ImportTextFile CStr(FName), Sep
>
> End Sub
>

Alicia,

Insert the line

WholeLine = Application.WorksheetFunction.Trim(WholeLine)

immediately AFTER

Line Input #1, WholeLine


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

<[email protected]> wrote in message
news:[email protected]...
> Hello.
>
> I found some really neat code by Chip Pearson
> (http://www.cpearson.com/excel/imptext.htm) that enables the
> user to
> specify a filename and delimiter, and then imports that file
> into an
> existing Excel worksheet using the said delimiter.
>
> My problem is that the text files I need to import use VARYING
> amounts
> of spaces as delimiters; therefore, my columns will not align
> correctly. I think I can work around this if I could modify
> Pearson's
> code so that it "treats consecutive delimiters as one" (an
> option that
> can be selected in the Import Wizard).
>
> I have very little experience in VBA, so I don't know how to
> modify it.
> Can someone help me?
>
> Thanks,
> Alicia
>
>
> Here is the code "as is":
>
> Public Sub ImportTextFile(FName As String, Sep As String)
>
> Dim RowNdx As Integer
> Dim ColNdx As Integer
> Dim TempVal As Variant
> Dim WholeLine As String
> Dim Pos As Integer
> Dim NextPos As Integer
> Dim SaveColNdx As Integer
>
> Application.ScreenUpdating = False
> 'On Error GoTo EndMacro:
>
> SaveColNdx = ActiveCell.Column
> RowNdx = ActiveCell.row
>
> Open FName For Input Access Read As #1
>
> While Not EOF(1)
> Line Input #1, WholeLine
> If Right(WholeLine, 1) <> Sep Then
> WholeLine = WholeLine & Sep
> End If
> ColNdx = SaveColNdx
> Pos = 1
> NextPos = InStr(Pos, WholeLine, Sep)
> While NextPos >= 1
> TempVal = Mid(WholeLine, Pos, NextPos - Pos)
> Cells(RowNdx, ColNdx).Value = TempVal
> Pos = NextPos + 1
> ColNdx = ColNdx + 1
> NextPos = InStr(Pos, WholeLine, Sep)
> Wend
> RowNdx = RowNdx + 1
> Wend
>
> EndMacro:
> On Error GoTo 0
> Application.ScreenUpdating = True
> Close #1
>
> End Sub
>
> ________________________________________
>
> Since this code has parameters, it will not appear in the
> standard
> "Macros" dialog list (ALT+F8). The following procedure will
> prompt you
> for the filename and delimiter character, and then run the
> ImportTextFile procedure.
>
> Public Sub DoTheImport()
> Dim FName As Variant
> Dim Sep As String
>
> FName = Application.GetOpenFilename _
> (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
> If FName = False Then
> MsgBox "You didn't select a file"
> Exit Sub
> End If
>
> Sep = InputBox("Enter a single delimiter character.", _
> "Import Text File")
> ImportTextFile CStr(FName), Sep
>
> End Sub
>

Hi Alicia,

I have used you code as a base and added a few lines

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim NextPos As Integer
Dim SaveColNdx As Integer


Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row


Open FName For Input Access Read As #1


While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
NextPos = InStr(1, WholeLine, Sep)
While NextPos >= 1
TempVal = Left(WholeLine, NextPos - 1)
Cells(RowNdx, ColNdx).Value = TempVal
ColNdx = ColNdx + 1
WholeLine = LTrim(WholeLine)
NextPos = InStr(1, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend


EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1


End Sub


HTH,

Executor

[email protected] wrote:
> Hello.
>
> I found some really neat code by Chip Pearson
> (http://www.cpearson.com/excel/imptext.htm) that enables the user to
> specify a filename and delimiter, and then imports that file into an
> existing Excel worksheet using the said delimiter.
>
> My problem is that the text files I need to import use VARYING amounts
> of spaces as delimiters; therefore, my columns will not align
> correctly. I think I can work around this if I could modify Pearson's
> code so that it "treats consecutive delimiters as one" (an option that
> can be selected in the Import Wizard).
>
> I have very little experience in VBA, so I don't know how to modify it.
> Can someone help me?
>
> Thanks,
> Alicia
>
>
> Here is the code "as is":
>
> Public Sub ImportTextFile(FName As String, Sep As String)
>
> Dim RowNdx As Integer
> Dim ColNdx As Integer
> Dim TempVal As Variant
> Dim WholeLine As String
> Dim Pos As Integer
> Dim NextPos As Integer
> Dim SaveColNdx As Integer
>
> Application.ScreenUpdating = False
> 'On Error GoTo EndMacro:
>
> SaveColNdx = ActiveCell.Column
> RowNdx = ActiveCell.row
>
> Open FName For Input Access Read As #1
>
> While Not EOF(1)
> Line Input #1, WholeLine
> If Right(WholeLine, 1) <> Sep Then
> WholeLine = WholeLine & Sep
> End If
> ColNdx = SaveColNdx
> Pos = 1
> NextPos = InStr(Pos, WholeLine, Sep)
> While NextPos >= 1
> TempVal = Mid(WholeLine, Pos, NextPos - Pos)
> Cells(RowNdx, ColNdx).Value = TempVal
> Pos = NextPos + 1
> ColNdx = ColNdx + 1
> NextPos = InStr(Pos, WholeLine, Sep)
> Wend
> RowNdx = RowNdx + 1
> Wend
>
> EndMacro:
> On Error GoTo 0
> Application.ScreenUpdating = True
> Close #1
>
> End Sub
>
> ________________________________________
>
> Since this code has parameters, it will not appear in the standard
> "Macros" dialog list (ALT+F8). The following procedure will prompt you
> for the filename and delimiter character, and then run the
> ImportTextFile procedure.
>
> Public Sub DoTheImport()
> Dim FName As Variant
> Dim Sep As String
>
> FName = Application.GetOpenFilename _
> (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
> If FName = False Then
> MsgBox "You didn't select a file"
> Exit Sub
> End If
>
> Sep = InputBox("Enter a single delimiter character.", _
> "Import Text File")
> ImportTextFile CStr(FName), Sep
>
> End Sub

Thanks so much, guys... I was in a real crunch with this!

I ended up adding Mr. Pearson's extra line because it worked best for
my particular situation.

Thanks again.

Alicia