Time Loop in VBA - Looping through Columns - vba

There are two sheets (sheet1 and sheet2).
Need to refresh sheet1 every 4 minutes as long as the workbook is open.
Then I Need to copy values from Column C in sheet1 to column C in sheet2 every 4 minutes.
Since new values would come in every 4 mins in sheet1, I want the values to be copied to a new column in sheet2 everytime.
I'm using the following code. The problem with my code is that the variable i is getting initiated fresh everytime and I am not able to initiate it to a value outside the module using Public i as long.
Sub copyvalues()
Dim i As Long
i = 3
Sheets(2).Columns(i).Value = Sheets(1).Range("C11:C90").Value
i = i + 1
Application.OnTime Now + TimeValue("00:04:00"), "copyvalues"
End Sub

Although you mention you can't declare variable i as Public, this should work:
For example, the following works without issues:
Public i As Long
Sub test()
Debug.Print i
Application.OnTime Now + TimeValue("00:00:01"), "Module1.test"
i = i + 1
End Sub
Try the following:
Public i As Long
Public SubIsRunning As Boolean
Sub initiatesubs()
If Not SubIsRunning = True Then
i = 3
Call copyvalues
SubIsRunning = True
End If
End Sub
Sub copyvalues()
Workbooks(REF).Sheets(2).Columns(i).Value = Workbooks(REF).Sheets(1).Range("C11:C90").Value
i = i + 1
Application.OnTime Now + TimeValue("00:04:00"), "Module1.copyvalues" 'assuming the sub is in Module1
End Sub

Related

VBA Userform: Update Total value in a label with multiple inputs, when entries change, by using a class module

I have a userform with 120 textboxes (10 years x 12 months). Going across are the months, and at the end is the total.
This is repeated 10 times for the 10 years going downwards
I would like it so the total label is updated when the values for the corresponding years' months change.
Textboxes are labelled for each year and month. The first one is 'TextBox1_1', the second is 'TextBox1_2'. for the third year, and fifth month it is 'TextBox3_5' and so forth.
I have a module which is set up to calculate the totals:
Sub totalVal(i As Integer)
Dim arr(1 To 12) As Integer
Dim j As Integer
For j = 1 To 12
If Trim(Basic_Info_Setup.Controls("TextBox" & i & "_" & j).Value & vbNullString) = vbNullString Then
Else
arr(j) = Basic_Info_Setup.Controls("TextBox" & i & "_" & j).Value
End If
Next j
Basic_Info_Setup.Year1_Total.Caption = Application.WorksheetFunction.Sum(arr)
End Sub
The 'i' will be passed as the year and the rest can be calculated. However to use this would a change event in all 120 textboxes which is far from ideal, but not undoable.
I have read and understand this is possible with a class module.
This one which shows how to do it with textboxes (Here) and I also had a look at how this one (Here) albeit it confused me more than it helped.
What do I need to do to make this class module for me?
I currently have in the class module, which is called 'clsLabel'
Private WithEvents MyTextBox As MSForms.TextBox
Public Property Set Control(tb As MSForms.TextBox)
Set MyTextBox = tb
End Property
Private Sub MyTextBox_Change()
totalVal (1)
End Sub
and in the userform
Private Sub UserForm_Initialize()
Dim tbCollection As Collection
Dim ctrl As MSForms.Control
Dim obj As clsLabel
Set tbCollection = New Collection
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.TextBoxThen
Set obj = New clsLabel
Set obj.Control = ctrl
tbCollection.Add obj
End If
Next ctrl
Set obj = Nothing
End Sub
when things work I would be happy to change the passing 'i' integer to be dynamic, I just have it set at 1 for now to see if it works for a specific year
There are no errors.
EDIT: corrections to above code as it now works
thanks

Object required error when looping through cells in selection

I am looping through some cells, in a vertical selection, in Excel, and then passing that cell as a parameter to a procedure.
I have done it this way, so I don't have the contents of ProcessCells twice, in the code, once for the while loop, and the second time in the For loop.
If I try and get the value of the cell written out, in the for loop, it works.
If I put the contents of the ProcessCells procedure in the for loop, it also works.
But if I try to pass it as a parameter, into ProcessCells, I am getting an error
'Object Required'
Here is the code, if you want to check it out:
Sub loopThroughCells()
Dim c As Range
Dim autoSelect As String
Dim X, Y As Integer
autoSelect = Cells(3, 2).Value
If StrComp(autoSelect, "Y") = 0 Then
Y = 5
X = 4
While Not IsEmpty(Cells(Y, X).Value)
ProcessCells (Cells(Y, X))
Y = Y + 1
Wend
Else
For Each c In Selection
ProcessCells (c)
Next c
End If
End Sub
Sub ProcessCells(ce As Range)
End Sub
How is
Cells(n,m)
different from
c In Selection
?
The error happens in the For loop, but it doesn't happen in the while loop.
Here is how you should do it:
Option Explicit
Sub TestMe()
Dim c As Range
For Each c In Selection
Call ProcessCells(c)
Next c
End Sub
Sub ProcessCells(ce As Range)
End Sub
You should refer with call, because you have an argument in parenthesis.
Or like this, if you do not like the call:
Option Explicit
Sub TestMe()
Dim c As Range
For Each c In Selection
ProcessCells c
Next c
End Sub
Sub ProcessCells(ce As Range)
End Sub
Plus a small edition of your code. Make your declarations like this:
Dim X as Long, Y As long
In your code X is declared as a variant, and integer is slower and smaller than long - Why Use Integer Instead of Long?
Here is some good explanation when to put the argument in parenthesis and when to use the call - How do I call a VBA Function into a Sub Procedure

Graphic objects update without skip, vba

I have a code, for example the class named MyClass and expect after each step the result is updated in the excel workbook, and some chart and graphic object is updated dynamically.
The delay of updating cells, charts and images is just ok but I have to add an additional pause because otherwise it will skip all the process and jumps graphic update to the end of code execution.
What should I do to getrid of unintended pause?
Public a As Double
Public b As Double
Public counter As Integer
Private Sub Class_Initialize()
a = Range("A1")
b = Range("B1")
counter = 1
End Sub
Public Sub some_calculation()
a = a + b
End Sub
Public Sub graphic_update()
counter = counter + 1
Cells(count, 1) = a
Sheet1.Shapes("Picture 1").Rotation = Sheet1.Shapes("Picture 1").Rotation + 45
End Sub
Public Function pause(pause_time As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= pause_time
End Function
Sub test()
Dim obj1 As New MyClass
For i = 1 To 10
obj1.some_calculation
obj1.graphic_update ' if I had a kind of confirmation of previous line execution, which is cells update, to go to the next one, it would be just ok.
obj1.pause (0.001)
Next i
End Sub
Since you requested an example of DoEvents - I would try something like this:
Public Sub graphic_update()
counter = counter + 1
Cells(count, 1) = a
Sheet1.Shapes("Picture 1").Rotation = Sheet1.Shapes("Picture 1").Rotation + 45
DoEvents '<<<
End Sub

Every 5 seconds record the value in 2 cells in another worksheet VBA

Problem:
I have searched extensively for this and cannot seem to get it to work. I have a timer running when the "StartBtn" is pressed:
Dim StopTimer As Boolean
Dim SchdTime As Date
Dim Etime As Date
Dim currentcost As Integer
Const OneSec As Date = 1 / 86400#
Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
[TextBox21].Value = "00:00:00"
End Sub
Private Sub StartBtn_Click()
StopTimer = False
SchdTime = Now()
[TextBox21].Value = Format(Etime, "hh:mm:ss")
Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub
Private Sub StopBtn_Click()
StopTimer = True
Beep
End Sub
Sub NextTick()
If StopTimer Then
'Don't reschedule update
Else
[TextBox21].Value = Format(Etime, "hh:mm:ss")
SchdTime = SchdTime + OneSec
Application.OnTime SchdTime, "Sheet1.NextTick"
Etime = Etime + OneSec
End If
End Sub
Then in another cell (say, C16) I have a manually entered value which is the hourly cost rate. I have a third cell that is calculating total cost by C16*current timer value.
What I want to do is record every 5 seconds after the "StartBtn" is clicked the current time and current calculated cost in another sheet. This is what I have started:
Sub increment()
Dim x As String
Dim n As Integer
Dim Recordnext As Date
n = 0
Record = [TextBox21].Value
Recordnext = [TextBox21].Value + OneSec
Range("B13").Value = Recordnext
Do Until IsEmpty(B4)
If [TextBox21].Value = Recordnext Then ActiveCell.Copy
Application.Goto(ActiveWorkbook.Sheets("Sheet2").Range("A1").Offset(1, 0))
ActiveSheet.Paste
Application.CutCopyMode = False
n = n + 1
Recordnext = [TextBox21].Value + 5 * (OneSec)
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
But it doesnt work. Any help would be appreciated.
I have tried to simplify your timer method down to what is actually needed.
Sheet1 code sheet
Option Explicit
Private Sub ResetBtn_Click()
bRun_Timer = False
'use the following if you want to remove the last time cycle
TextBox21.Value = Format(0, "hh:mm:ss")
End Sub
Private Sub StartBtn_Click()
bRun_Timer = True
dTime_Start = Now
TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
Range("D16").ClearContents
Call next_Increment
End Sub
Module1 code sheet
Option Explicit
Public bRun_Timer As Boolean
Public Const iSecs As Integer = 3 'three seconds
Public dTime_Start As Date
Sub next_Increment()
With Worksheets("Sheet1")
.TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
.Range("D16") = Sheet1.Range("C16") / 3600 * _
Second(TimeValue(Sheet1.TextBox21.Value)) '# of secs × rate/sec
Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _
Array(.TextBox21.Value, .Range("D16").Value)
End With
If bRun_Timer Then _
Application.OnTime Now + TimeSerial(0, 0, iSecs), "next_Increment"
End Sub
Note that the operation of transferring the data to Sheet2 is a direct value transfer¹ with no .GoTo, ActiveCell or Select.
It was not entirely clear to me what you were trying to do with the value transfer. I have stacked them one after another on Sheet1.
        
You would benefit by adding Option Explicit² to the top of all your code sheets. This requires variable declaration and if you misplace a public variable, you will quickly know.
¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
² Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.

How to dynamically count UBound() values?

I got something like this:
For i = 1 to 4
cur_tab = "tab_event" & i
For e = 1 to Ubound(cur_tab)
' do something
Next
Next
I need to dynamically change the cur_tab , but it's not working due to Ubound(cur_tab) is returning a String(e.g.) *Ubound("tab_event1")*
*I've declared all vars and of course I have 'i' tables
"Subscript out of range"
Any ideas ?
What you are trying to achieve is called Variable Variables. It doesn't work like that in VBA. If you have a common procedure then use a separate procedure and use that again and again.
For example, your code can be written as
Sub Sample()
'
'~~> Rest Of Your Code
'
For e = 1 To UBound(tab_event1)
MySub
Next
For e = 1 To UBound(tab_event2)
MySub
Next
For e = 1 To UBound(tab_event3)
MySub
Next
For e = 1 To UBound(tab_event4)
MySub
Next
'
'~~> Rest Of Your Code
'
End Sub
Sub MySub()
MsgBox "Hello World!"
End Sub