Progress Bar / Status Bar

[sheeeng]

Hello.
I want to find out the progress of the text file extraction.
I want to find out the total lines in the source file before extract data.
Please advise.
How do I put in a label on form to show the progress of the process done?

Public Sub ImportTextFile(fName As String, Sep As String)
' This code imports a "text" file
' It takes a full path filename and a text separator
' character as inputs... The macro is called from the
' "Do the Import" macro further down this code pane
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
RowNdx = 2 'Start import data to row 2
Open fName For Input Access Read As #1
'open the text file
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1 'Set import data from first character in imported text
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

Please help. Thanks.

[BlueCactus]

I'm not sure if there's a way of finding out how many lines are in a file without opening it and scanning through it. (Perhaps there is a way of calculating how much data you've read and relating that to the file size instead.) So this is the easy (to code, but less satisfactory to execute) way:

LineCount = 0
Open fName For Input Access Read As #1 
While Not EOF(1) 
        Line Input #1, WholeLine
LineCount = LineCount +1
Wend
Close #1
' your code goes next:
    Open fName For Input Access Read As #1 
     'open the text file
While Not EOF(1) 
        Line Input #1, WholeLine
'... et cetera

This is really only useful if your processing is intensive enough that it's actually worth reading through the whole file first.

As far as a progress bar goes, there are a few KB articles on stand-alone progress bars. If you're really using a form, then it might be easier to place one directly on the form. Here's one way:

1. Create a text label on the form, and name it something like LabelProgress
2. Delete any .Caption text.
3. Change the .BackColor to something visible, like blue.
4. Stretch it out to the full width that corresponds to 100% progress.
5. Insert code something like the following:

FullWidth = LabelProgress.Width
LabelProgress.Width = 0
 While Not EOF(1) 
        Line Input #1, WholeLine 
        If Right(WholeLine, 1) <> Sep Then 
            WholeLine = WholeLine & Sep 
        End If 
' <snip>
NextPos = InStr(Pos, WholeLine, Sep) 
        Wend 
        RowNdx = RowNdx + 1
 LabelProgress.Width = FullWidth * (RowNdx - 1)/LineCount
' Insert the real name of your userform
UserForm.Repaint
    Wend 
LabelProgress.Width = 0

You can also add things such as LabelProgress.Visible = True or False to show / hide the progress bar as necessary.

Edit: Just to clarify, I mentioned the last stuff in case you'll be calling this procedure more than once. Then I would set LabelProgress.Visible = False in VBE, LabelProgress.Visible = True at the start of the above code, LabelProgress.Width = FullWidth and LabelProgress.Visible = False at the end.

[gsouza]

I am not really sure what you mean but this counts the lines in a txt file without opening it.

Sub dataentrytxt2()
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim CountLines As Double
On Error GoTo handler:
FileName = InputBox("Enter the file you would like to read from.", , "C:\")
If FileName = "" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
CountLines = 1
Do While Seek(FileNum) <= LOF(FileNum)
Line Input #FileNum, ResultStr
CountLines = CountLines + 1
Loop
Close
MsgBox "Number of lines for " & FileName & " = " & CountLines - 1
Range("sheet1!ck4") = CountLines - 1
Exit Sub
handler: MsgBox "You did not type in the correct alternate file path and name."
End Sub

[Andy Pope]

Hi,

This will calculate the progression through the file as it goes along.
Place 2 labels and a commandbutton on a userform. Change the Open command to suit.

Private Sub CommandButton1_Click()
Dim intUnit As Integer
    Dim lngNChars As Long
    Dim lngNCharsSofar As Long
    Dim strTemp As String
With Label1
        .TextAlign = fmTextAlignCenter
        .ForeColor = RGB(0, 0, 255)
        .BackColor = RGB(255, 255, 255)
        .Caption = ""
    End With
    With Label2
        .TextAlign = fmTextAlignCenter
        .Move Label1.Left, Label1.Top, 0, Label1.Height
        .BackColor = RGB(0, 0, 255)
        .ForeColor = RGB(255, 255, 255)
        .Caption = ""
    End With
intUnit = FreeFile
    Open "C:\temp\info.txt" For Input As #intUnit
    lngNChars = LOF(intUnit)
    Do While Not EOF(intUnit)
        Line Input #intUnit, strTemp
        lngNCharsSofar = lngNCharsSofar + Len(strTemp)
        Label2.Width = Label1.Width * (lngNCharsSofar / lngNChars)
        DoEvents
    Loop
    Close intUnit
    Label2.Width = Label1.Width
End Sub

[sheeeng]

Thanks. It's Works.
VBA Express Forum the Best.

[sheeeng]

Here is my code that is working in my excel macro.

Please put in a Frame = FrameProgress; Label = LabelProgress in the UserForm1. The label put inside the frame.

Past value od progress to this sub.
Walla!! You have made yourself a Status Bar.

Sub UpdateProgressBar(PctDone As Double)
    With UserForm1
        ' Update the Caption property of the Frame control.
        .FrameProgress.Caption = "Progress : " & Format(PctDone, "0%")
        ' Widen the Label control.
        .LabelProgress.Width = PctDone * (.FrameProgress.Width - 25)
    End With
    ' The DoEvents allows the UserForm to update.
    DoEvents
End Sub