VBA Text import and sort Excel

Question

I have routine tasks which require pulling data from an obsolete SPC package and putting it into Excel. The SPC software will only export into a text file.

I have put pieced together a script to import this into excel, break it into different sheets and do a little bit of cleaning on it. I am sure this is not the most efficient code. Any advice on cleaning this up, error handling or streamlining?

Option Explicit
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
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 ws As Worksheet
Dim SheetNumber As Long
Const C_START_SHEET_NAME = "Sheet1"
SheetNumber = 1
RowNdx = 1
Set ws = ActiveWorkbook.Worksheets(C_START_SHEET_NAME)
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
 'This section added to create new sheets for empty lines
 If WholeLine = "" Then
 SheetNumber = SheetNumber + 1
 Set ws = ActiveWorkbook.Worksheets.Add(after:=ws)
 RowNdx = 1
 End If
 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
 SheetNumber = SheetNumber + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
Sub DoTheImport()
 Dim FileName As Variant
 Dim Sep As String
 FileName = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*.txt")
 If FileName = False Then
 ''''''''''''''''''''''''''
 ' user cancelled, get out
 ''''''''''''''''''''''''''
 Exit Sub
 End If
 Sep = vbTab 'Application.InputBox("Enter a separator character.", Type:=2)
 If Sep = vbNullString Then
 ''''''''''''''''''''''''''
 ' user cancelled, get out
 ''''''''''''''''''''''''''
 Exit Sub
 End If
 Debug.Print "FileName: " & FileName, "Separator: " & Sep
 ImportTextFile FName:=CStr(FileName), Sep:=CStr(Sep)
 Call RemoveBlankRowsColumns
 Call CleanChar
 Call TabName
 Call A2_Format
End Sub
Private Sub RemoveBlankRowsColumns()
Dim ws As Worksheet
 For Each ws In ThisWorkbook.Sheets
 On Error Resume Next
 ws.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 On Error GoTo 0
Next
End Sub
Private Sub TabName()
Dim ws As Worksheet
Dim myString As String
Dim newString As String
For Each ws In Worksheets
 With ws
 If .Range("A1").Value <> "" Then .name = .Range("A1").Value
 End With
Next ws
End Sub
Private Sub CleanChar()
Dim rCell As Range
Dim rRng As Range
Dim rCol As Range
Dim ws As Worksheet
Dim myString As String
Dim newString As String
For Each ws In Worksheets
With ws
 Set rRng = ws.Range("A1:A50")
 For Each rCol In rRng.Columns
 For Each rCell In rCol.Rows
 myString = rCell.Value
 newString = Replace(Replace(myString, ":", ""), """", "")
 rCell.Value = newString
 Next rCell
 Next rCol
End With
Next ws
End Sub
Private Sub A2_Format()
Dim rCell As Range
Dim rRng As Range
Dim rCol As Range
Dim ws As Worksheet
Dim myString As String
Dim newString As String
Dim splitTarget As Variant
Dim a As Integer
For Each ws In Worksheets
With ws
 Set rRng = ws.Range("A2")
 For Each rCol In rRng.Columns
 For Each rCell In rCol.Rows
 myString = rCell.Value
 newString = Replace(Replace(Replace(myString, "(", ","), ")", ","), "=", ",")
 splitTarget = Split(newString, ",")
 For a = 0 To UBound(splitTarget)
 ws.Cells(2, a + 1).Value = splitTarget(a)
 Next a
 Next rCell
 Next rCol
End With
Next ws
End Sub

Answer 1

Your indentation is inconsistent. That's easy to fix: enter a block? hit Tab and add an indentation level. Exit a block? hit Backspace and remove an indentation level.

So this:

For a = 0 To UBound(splitTarget)
ws.Cells(2, a + 1).Value = splitTarget(a)
Next a

Becomes this:

For a = 0 To UBound(splitTarget)
 ws.Cells(2, a + 1).Value = splitTarget(a)
Next a

And this:

For Each ws In Worksheets
With ws

Becomes this:

For Each ws In Worksheets
 With ws

A procedure is also a block (it defines a scope!) and anything under a procedure/function signature should be indented one level too.

---

I'm not sure why this line is commented-out:

'On Error GoTo EndMacro:

The colon is superfluous here; VBA picks it up as an instruction separator, which would let you have multiple instructions on the same line of code (not that I'd recommend ever doing that).

So that would get parsed as, roughly, [OnErrorStatement][EmptyInstruction][EndOfLine].

Should be simply On Error GoTo EndMacro.

Whenever you're toggling Application.ScreenUpdating off, you must handle errors and make sure you're toggling it back on.

---

When you're opening a file...

Open FName For Input Access Read As #1

You shouldn't hard-code the file number handle. Instead, use the FreeFile function to have VBA give you a free file number:

Dim fileNumber As Integer
fileNumber = FreeFile
Open FName For Input Access Read As #fileNumber

---

If WholeLine = "" Then

Instead of "" empty string, you should use the built-in constant vbNullString, which returns a null string pointer. "" allocates an extraneous string variable, which is redundant.

---

SheetNumber is declared (good), assigned (good) ...but never used (bad).

You're reading the file and writing to the active sheet at the same time; these are two distinct things that should be separated. Also...

Cells(RowNdx, ColNdx).Value = TempVal

You're assigning an object reference to what I'd believe is the sheet you want to write to (ws), but you're implicitly writing to the active sheet - your code is assuming that the active sheet is the same... which is flaky.

In fact, the only thing the ws sheet reference is used for, is to determine where the next sheet should be inserted. You have an object reference, use it!

ws.Cells(RowNdx, ColNdx).Value = TempVal

---

You don't need the Call statement here:

Call RemoveBlankRowsColumns
Call CleanChar
Call TabName
Call A2_Format

In fact, nobody ever needs to use Call - it's an obsolete construct. This is 100% equivalent:

RemoveBlankRowsColumns
CleanChar
TabName
A2_Format

---

You have unused variables in the TabName procedure:

Dim myString As String
Dim newString As String

Procedure names should start with a verb, they do something. SetTabName would be much better.

---

Looking at what CleanChar is doing, I think you have performance issues. If you started by splitting reading the file contents from writing to the cells, you could implement that cleanup logic in-between, so that you would only write to the cells once you know exactly what you want to see in each cell.

Writing to cells in a loop is one of the most expensive thing you can do in Excel VBA: you need to minimize it as much as possible.

---

I'd go with another approach.

I'd create a class module to encapsulate an entity representing a single record. Something like this:

'Class "RecordItem"
Option Explicit
Private Type TRecord
 Id As Long
 Name As String
 Description As String
 '...
End Type
Private this As TRecord
Public Property Get Id() As Long
 Id = this.Id
End Property
Public Property Let Id(ByVal value As Long)
 this.Id = value
End Property
Public Property Get Name() As String
 Name = this.Name
End Property
Public Property Let Name(ByVal value As String)
 this.Name = value
End Property
Public Property Get Description() As String
 Description = this.Description
End Property
Public Property Let Description(ByVal value As String)
 this.Description = value 
End Property
...

Whatever, you get the idea.

Then I'd read the file, and create a new RecordItem object for each line, store each item in a collection, and then close the file as soon as I'm done.

The logic for cleaning up the data is the logic for coming up with a RecordItem object, so I'd put that in its own function - one that takes a String input and returns a RecordItem object.

Once you have all your items in a collection, all that's left to do is iterate the collection and write to the worksheets; if an item needs a WorksheetName property, then let it have a WorksheetName property, and use that to determine when you need to create a new sheet.

If an error occurs processing the data, you're not leaving the file opened in a limbo status - if an error occurs processing the data, the file has long been closed already.

• Tom Ruh: @Mats Mug - Thank you. I will apply google to this and it should help me a lot.