Progress Bar
 

Is it possible to generate a progress bar to run when my database search
macros are running. The type you see when your installing software type
of thing.


--
grahammal
------------------------------------------------------------------------
grahammal's Profile: http://www.excelforum.com/member.php...o&userid=20336
View this thread: http://www.excelforum.com/showthread...hreadid=482156

Progress Bar
 

Yes!
Check out j-walk web site he's got examples
Dave

Progress Bar
 

Good morning grahammal

...or go here for a collection of trendy alternative ones.

http://www.andypope.info/vba/pmeter.htm

HTH

DominicB


--
dominicb
------------------------------------------------------------------------
dominicb's Profile: http://www.excelforum.com/member.php...o&userid=18932
View this thread: http://www.excelforum.com/showthread...hreadid=482156

Progress Bar
 

grahammal:

To use the example you will need to drop a cmd button
and a progressbar on the worksheet. Set the max value
of the progressBar to to 10,000.

Obviously, the trickey part is to tie it to something
meaningful in your code, but this illustrates the
machanics.


Private Sub CommandButton1_Click()

Dim intCounter As Integer
Dim i As Integer
Dim sum As Integer
i = 0

'///// Microsoft Windows Common Control 6.0
ProgressBar1.Visible = True

For i = 1 To 10000

Do While intCounter < i
intCounter = intCounter + 1

'///// Update progress.''
ProgressBar1.Value = intCounter
sum = sum + 1
' Print sum

Loop
Next i

ProgressBar1.Visible = False

End Sub

Good Luck
TK

Progress Bar
 

where in that code do you drop the actual macro?

Progress Bar
 

damorrison:

This examply brings in a recordset from Access and uses the
progressbar and a timer. You will need to change the path to
Nwind on your computer to test it, but as stated the trickey part
of a progressbar is to tie the bar to something meaninful, in this
example it is tied to the recordcount of the recourdset.

Put a cmd button, a progressBar and two labels on sheet1

'To use ADO objects in an application add a reference
'to the ADO component. From the VBA window select
'Tools/References< check the box
' "Microsoft ActiveX Data Objects 2.5 Library"

Post back if you have a problem it is kind of a fun example.

Private Sub CommandButton1_Click()

Dim lngStart As Double
Dim lngStop As Double
Dim lngTime As Double

lngStart = Timer

Dim db_Name As String
Dim DB_CONNECT_STRING As String

db_Name = ("C:\Program Files\Microsoft Visual Studio\VB98\NWIND.mdb")
DB_CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & db_Name & ";" & ", , , adConnectAsync;"
'Create the connection
Dim cnn As New ADODB.Connection
Set cnn = New Connection
cnn.Open DB_CONNECT_STRING

'Create the recordset
Dim rs As ADODB.Recordset
Set rs = New Recordset

'Determines what records to show
Dim strSQL As String
'strSQL = "SELECT Orders.OrderID, Orders.ShipAddress FROM Orders;"
'Dim strSQL As String
strSQL = "SELECT Orders.OrderID, Orders.ShipAddress FROM Orders;"
'Retreive the records
rs.CursorLocation = adUseClient
rs.Open strSQL, cnn, adOpenStatic, adLockBatchOptimistic

Dim iRow As Integer
iRow = 3

Dim intCounter As Integer
Dim i As Integer
i = 0
ProgressBar1.Visible = True
ProgressBar1.Max = rs.RecordCount

Label1.Caption = "Total Items " & rs.RecordCount
Label1.BackColor = &HFFFF&

'ListBox1.Clear
With rs
.MoveFirst
Do Until .EOF
' ListBox1.AddItem rs("OrderID") & vbTab & rs("ShipAddress")
Worksheets("Sheet1").Range("A" & iRow) = rs("OrderID")
Worksheets("Sheet1").Range("C" & iRow) = rs("ShipAddress")
.MoveNext
iRow = iRow + 1

intCounter = intCounter + 1
ProgressBar1.Value = intCounter

Loop
End With
Worksheets("Sheet1").Range("A1") = "OrderID"
Worksheets("Sheet1").Range("C1") = "Shiping Address"

Worksheets("Sheet1").Range("A1:C1").Font.ColorInde x = 3
Worksheets("Sheet1").Range("A1:C5").Font.Bold = True
Worksheets("Sheet1").Range("A1:C1").Font.Underline = True

ProgressBar1.Visible = False

lngStop = Timer

lngTime = (lngStop - lngStart)
DoEvents
Label2.Caption = Format(lngTime, "##.000") & " Seconds"
Label2.BackColor = &HFFFF&
DoEvents
MsgBox ("That Took " & Format(lngTime, "##.000") & " Seconds")

'Close the connection
cnn.Close
Set cnn = Nothing

'Destroy the Recordset
Set rs = Nothing
Exit Sub

End Sub

Good Luck
Tk

damorrison Wrote

where in that code do you drop the actual macro?

Progress Bar