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.