Is it possible to loop a macro constantly?

[fuze]

Hi, I am wondering whether it is possible to make a macro loop constantly while a spreadsheet is open? Or even better, to loop constantly whenever the mouse click button is being held down?

I have some macros which read the information from a text file and input the data into the workbook, but i need to get it to do it constantly, because the data in the text file is changing because I am writing to it from max msp.

At the moment you click the button to read the text file but i need it to read the file whenever the mouse buttno is held down, not just clicked, because as i click the button and drag the mouse the text file data will be changing so i need the spreadsheet to continually update itself.

is that possible?

The code i have is below

MODULE 1

[VBA]
Option Explicit

Dim myDB As clsADODBopen

Sub Main()
Dim strCmn As String
Dim FN As String
FN = "testing.txt"
Set myDB = New clsADODBopen
strCmn = "select * from " & FN
With myDB
.subConn ThisWorkbook.Path & "\"
.subOpen strCmn
End With
subShow
Set myDB = Nothing
End Sub

Sub subShow()
Dim i As Integer, c As Long
Dim pt As Range

Set pt = ActiveSheet.Range("a1")
pt.Worksheet.Cells.ClearContents
c = 0
With myDB.theRST
For i = 1 To .Fields.Count
If c = pt.Worksheet.Cells.Columns.Count Then
c = 0
Set pt = pt.Offset(1, 0)
End If
pt.Offset(0, c).Value = .Fields(i - 1).Name
c = c + 1
Next
'pt.Offset(1, 0).CopyFromRecordset myDB.theRST
End With
End Sub

MODULE 2
Option Explicit

Dim theCON As ADODB.Connection
Public theRST As ADODB.Recordset


Sub subConn(strFullName As String)
Dim strDrv As String

strDrv = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
" DBQ=" & strFullName & ";"
theCON.Open "Provider=MSDASQL; " & strDrv
End Sub


Sub subOpen(strCmn As String)
theRST.Open Source:=strCmn, ActiveConnection:=theCON
End Sub


Private Sub Class_Initialize()
Set theCON = New ADODB.Connection
Set theRST = New ADODB.Recordset
End Sub


Private Sub Class_Terminate()
theCON.Close
Set theRST = Nothing
Set theCON = Nothing
End Sub
[/VBA]

thanks in advance for your help!

[MikeBlackman]

Hi,

What method have you used to get the text file into Excel?

[Kenneth Hobs]

I am not sure that an infinite loop would be efficient. Even one that keeps checking a file size would be cpu intensive. Instead, I recommend an interval to check such as OnTime. See this as an example: http://vbaexpress.com/forum/showthread.php?t=25896

[fuze]

It is this bit of the code

Sub Main() 
    Dim strCmn As String 
    Dim FN As String 
    FN = "testing.txt" 
    Set myDB = New clsADODBopen 
    strCmn = "select * from " & FN 
    With myDB 
        .subConn ThisWorkbook.Path & "\" 
        .subOpen strCmn 
    End With 
    subShow 
    Set myDB = Nothing 
End Sub 

I am not sure exactly how the thing works, i have attached the workbook.

I amended some code someone had posted in an example of reading from a text fille.

I am very new to vba but this does what i want it to except i need it to keep repeating the procedure continously so that it updates any changes to the text file in real time.

[fuze]

Cheers for this kenneth.

however I am still a bit confused. i know taht running it on an infinite loop wouldnt be idea but i think it would do what i need it to do. How exactly does on time work, would it check if the file is different say once every 0.05 seconds and then only input new data into the spreadsheet when there is new data in the text file?

because that work for me

[Kenneth Hobs]

Review the thread that I referenced. It is watching a folder so that should be ideal for your case. When it finds that the folder is not changing size it ends and updates a cell. You can trigger your macro based on that condition or just trigger it at each OnTime interval.

[fuze]

I did look at that thread but didnt quite understand it, I am still very new to programming!

the thing is, the text file will often stay the same size because max mso will be replacing the numbers and not adding new numbers to the text fuile so the size wont be changing. So triggering the macro on the on time intervals sounds like the best way to do it. How would i insert it into the code so that it re triggered the macro on a time interval? it doesnt really make sense to me.

Cheers!

[Benzadeus]

How about trigger the macro when the file CRC changes?

[fuze]

now I am completely lost! So, does any acticity in a file change the CRC?

and how would i do that?

Cheers!

[Kenneth Hobs]

It would not be hard to add what you want to the OnTime method that I explained. You can have it keep checking while the workbook is open or stop if you run another macro to set some Public variable that the OnTime routine checks or some cell value.

If you attach a simple text file example, we could give a more specific solution.

Another method is QueryTables. Here is an example using an MDB as the datasource. You would need to modify it to work with a text file. One would set a refresh interval. You can record a QueryTable macro to get the connection string or see connectionstrings.com.

[VBA]Sub Test()
Dim mdbPath As String, dbName As String, cmdText As String
Dim rngDestination As String
'mdbPath = "E:\ADO\NWind2003.mdb" 'change the path here to suit your needs
'mdbPath = "c:\myfiles\edrive\excel\ado\NWind2003.mdb"
mdbPath = "//matpc10/ExcelVBAExamples/ado/NWind2003.mdb"
dbName = "NWind2003_1" 'change the database name here to suit your needs
cmdText = "Aug94" 'change the stored SQL here to suit your needs
rngDestination = "A1" 'change the destination range here to suit your needs

'Clear previous data
Cells.Delete

InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination

'Insert other data to the right of A1 with a blank column separating the two
rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
cmdText = "Sales by Category"
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub

Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
cmdText As String, rngDestination As String, _
Optional bFieldNames = True)

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
, """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDBatab" _
, "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
, "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=False;Jet OLEDB:Co" _
, "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
.CommandType = xlCmdTable
.CommandText = Array(cmdText)
.Name = dbName
.FieldNames = bFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = mdbPath
.Refresh BackgroundQuery:=False
End With
End Sub[/VBA]

[fuze]

It is literally 5 numbers between 1 and 12 separated by commas so the numbers are entered into different cells.

i.e 1, 5, 8, 6, 12, entered into b2,c2,d2,e2 and f2 respectively.

The max msp patch will be writing data to the text file and I want the vba script to read it so that whenever the data changes the chart updates automatically. I have slightly altered the workbooka and added the chart to make it clearer

It is attached, and the code is also below. Thank you for your patience!

I will want to set up the ontime so that it checks the text file every 0.05 of a second whilst the workbook is open.

Onca again thank you very much!

MODULE 1

Option Explicit
 
Dim myDB As clsADODBopen

Sub Main()
Dim strCmn As String
Dim FN As String
    FN = "testing.txt"
    Set myDB = New clsADODBopen
    strCmn = "select * from " & FN
    With myDB
        .subConn ThisWorkbook.Path & "\"
        .subOpen strCmn
    End With
    subShow
    Set myDB = Nothing
End Sub

Sub subShow()
Dim i As Integer, c As Long
Dim pt As Range
 
    Set pt = ActiveSheet.Range("b2")
    c = 0
    With myDB.theRST
        For i = 1 To .Fields.Count
            If c = pt.Worksheet.Cells.Columns.Count Then
                c = 0
                Set pt = pt.Offset(1, 0)
            End If
            pt.Offset(0, c).Value = .Fields(i - 1).Name
            c = c + 1
        Next
        'pt.Offset(1, 0).CopyFromRecordset myDB.theRST
    End With
End Sub

MODULE 2

Option Explicit
 
Dim theCON As ADODB.Connection
Public theRST As ADODB.Recordset

 
Sub subConn(strFullName As String)
Dim strDrv As String
 
    strDrv = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
    " DBQ=" & strFullName & ";"
    theCON.Open "Provider=MSDASQL; " & strDrv
End Sub

 
Sub subOpen(strCmn As String)
    theRST.Open Source:=strCmn, ActiveConnection:=theCON
End Sub

 
Private Sub Class_Initialize()
    Set theCON = New ADODB.Connection
    Set theRST = New ADODB.Recordset
End Sub

 
Private Sub Class_Terminate()
    theCON.Close
    Set theRST = Nothing
    Set theCON = Nothing
End Sub

[Kenneth Hobs]

Understand that OnTime is an Application event. So, if you are in another xls, it will keep running. I set it to Stop if that workbook is closed. Right click the Excel icon to the left of the File menu and paste:
[vba]Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub[/vba]
In your routine I added just a bit. Playing Main will not not stop until the workbook is closed. One second is the mimimum amount of time to refresh your data from the text file. That should be fast enough.
[vba]
Dim myDB As clsADODBopen
Public dTime As Date

Sub Main()
Dim strCmn As String
Dim FN As String

On Error Resume Next
FN = "testing.txt"
Set myDB = New clsADODBopen
strCmn = "select * from " & FN
With myDB
.subConn ThisWorkbook.Path & "\"
.subOpen strCmn
End With
subShow
Set myDB = Nothing
StartTimer
End Sub

Sub subShow()
Dim i As Integer, c As Long
Dim pt As Range

Set pt = ActiveSheet.Range("b2")
c = 0
With myDB.theRST
For i = 1 To .Fields.Count
If c = pt.Worksheet.Cells.Columns.Count Then
c = 0
Set pt = pt.Offset(1, 0)
End If
pt.Offset(0, c).Value = .Fields(i - 1).Name
c = c + 1
Next
'pt.Offset(1, 0).CopyFromRecordset myDB.theRST
End With
End Sub

Sub StartTimer()
dTime = Now + TimeValue("00:00:01")
Application.OnTime dTime, "Main", , True
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime dTime, "Main", , False
End Sub
[/vba]
Of course you could add a button so that the user could stop the timer.
[vba]
Private Sub CommandButton1_Click()
StopTimer
End Sub
[/vba]
You could put the text filename in a cell or present an initial dialog for the user to pick the text filename rather than making the user set it in the code.

[fuze]

Brilliant, hanks alot for that Kenneth!

however it seems that 1 second is a little bit jerky, how would i go about making it trigger every time the file crc changes? I think that would be mroe responsive. Cheers!

[Kenneth Hobs]

I thought you wanted an infinite loop? You could increase the timer interval. We could end it if the file size did not change from one interval to another as I first explained in the referenced link.

Have you tried turning off screen updating and calculation? See my SpeeUp routines: http://vbaexpress.com/kb/getarticle.php?kb_id=1035

After adding the Module in the link above, use it it like this:
[VBA]Sub subShow()
Dim i As Integer, c As Long
Dim pt As Range
On Error GoTo EndNow
SpeedOn
Set pt = ActiveSheet.Range("b2")
c = 0
With myDB.theRST
For i = 1 To .Fields.Count
If c = pt.Worksheet.Cells.Columns.Count Then
c = 0
Set pt = pt.Offset(1, 0)
End If
pt.Offset(0, c).Value = .Fields(i - 1).Name
c = c + 1
Next
End With
EndNow:
SpeedOff
End Sub[/VBA]

[Benzadeus]

I'm afraid I'm not finding the CRC check macro on my library...

[fuze]

I am confused now kenneth! Originally i did think that the best way to do this would be an infinite loop. Now I have realised it will work best if the macro is triggered the instant that the text files changes.

If I increase the time interval it will make the response even slower. 1 second is not quick enough for me, so i thought if i could get the macro to trigger the instant the file changes then that would create a more responsive action.

[Kenneth Hobs]

The only way to trigger an instant check would be to use all of a cpu in an infinite loop. Press Esc key to exit.

In this method, I copied the file to the temp folder. Since it is getting the text of the file, one could just use it to fill the data if it is small as you indictated, rather than an ADO method as well.

[VBA]Dim myDB As clsADODBopen
Public tf As Boolean

'Infinite Loop
Sub Main()
Dim strCmn As String
Dim pathFN As String, FN As String, fullFN As String
Dim oldStr As String, newStr As String, tmpFullFN As String

On Error Resume Next

FN = "testing.txt"
pathFN = ThisWorkbook.Path & "\"
fullFN = pathFN & FN
tmpFullFN = Environ("temp") & "\" & FN
tf = False
Do
FileCopy fullFN, tmpFullFN
newStr = OpenTextFileToString(tmpFullFN)
Kill tmpFullFN
Set myDB = New clsADODBopen
strCmn = "select * from " & FN
With myDB
.subConn pathFN
.subOpen strCmn
End With
If oldStr <> newStr Then
oldStr = newStr
subShow
End If
Set myDB = Nothing
Loop Until tf = True
End Sub

Sub subShow()
Dim i As Integer, c As Long
Dim pt As Range

On Error GoTo EndNow
'SpeedOn and SpeedOff needs SpeedUp Module in:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn
Set pt = ActiveSheet.Range("b2")
c = 0
With myDB.theRST
For i = 1 To .Fields.Count
If c = pt.Worksheet.Cells.Columns.Count Then
c = 0
Set pt = pt.Offset(1, 0)
End If
pt.Offset(0, c).Value = .Fields(i - 1).Name
c = c + 1
Next
'pt.Offset(1, 0).CopyFromRecordset myDB.theRST
End With
EndNow:
SpeedOff
End Sub

Function OpenTextFileToString(ByVal strFile As String) As String
Dim hFile As Long
hFile = FreeFile
Open strFile For Input As #hFile
OpenTextFileToString = Input$(LOF(hFile), hFile)
Close #hFile
End Function[/VBA]

[fuze]

Thank you very much for this kenneth you have been a great help. Sorry about the delay in replying, i have been away working on another project.

this now works perfectly, the only thing is is that when i press escape to get out of it it takes me to the code window. is there any way to stop running the code without opening up the visual basic editor?

Cheers!

[fuze]

I had stupidly copied the code in wrong and it was still running on the 1second timer and i had thought it was still lagging a bit but working ok.

It now does work a lot more responsively but as you said it is too cpu intense - the programme crashed quite often and fails to respond which isnt ideal. I think i will have to look into the method of making the macro trigger every time the crc of the tex file changes. then it will trigger every time i need it to trigger instantly but will not use all the cpu.

thanks a hell of a lot for all your help, id be stuck without it!

[Kenneth Hobs]

If you want to do the OnTime event say at every 1/2 second interval, then change the TimeValue("00:00:01") to 1.15740740740741E-05 / 2. Divide by 10 if you want every 1/10s interval.

e.g.
[vba]Sub StartTimer()
dTime = Now + 1.15740740740741E-05 / 2
Application.OnTime dTime, "Main", , True
End Sub [/vba]

Post #17 is getting the file contents so it will only update the values if the file contents changed. Using a CRC method it is checking each character.