VBA not working

[Patrickwest]

Hi to everyone.

Currently I am using the following programme in workbook1

Dim Seconds As  long
Dim Minutes As  long
Dim CurrentRow As  long
Dim CurrentColumn As  long
Dim Initalised As Boolean

Private Sub Recalc()
    If (CurrentRow <> 0 And CurrentColumn <> 0) Then
        Cells(CurrentRow, CurrentColumn).Value = Format(Now, "dd/mm/yy")
        Cells(CurrentRow, CurrentColumn+1).Value = Format(Time, "hh:mm:ss AM/PM")
        
        Seconds = Seconds + 1
        
        If (Seconds = 60) Then
            Minutes = Minutes + 1
            CurrentRow = CurrentRow + 1
            Seconds = 0
        End If
        
        ' Stop repeating after 24 hours (1440 minutes)
        If (Minutes < 1440) Then
            Call SetTime
        Else
            Initalised = False
        End If
    End If
End Sub

Sub SetTime()
    If (Not Initalised) Then
        Initalised = True
        
        ' Initialise variables.
        Seconds = 0
        Minutes = 0
        CurrentRow = ActiveCell.Row
        CurrentColumn = ActiveCell.Column
    End If

    SchedRecalc = Now + TimeValue("00:00:01")
    Application.OnTime SchedRecalc, "Recalc"
End Sub

The result of the above will be shown in Cells A1 and B1 all the way to Cells A1440 and B1440.

Cell C1 will have for example as 00:00:00 (Time). Cell C2 will be 00:01:00 and so on until Cell C1440.

Cell D1 will have formula IF(B1=C1,1,"") and continue all the way to Cell D1440.

Cell E1 will have the formula VALUE(D1) and continue all the way to Cell E1440.


Workbook 2 has the following programme.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    Cells(Target.Row, 3) = Evaluate("=IF(B" & Target.Row & "=1,RANDBETWEEN(0,9),"""")")
End Sub

In workbook2 Cell A1 will have cut & paste with link from workbook1 Cell E1. This continue till Cell A1440.

Cell B1 in workbook2 will have a formula IF(A1=1,1,""). This will continue till Cell B1440.

Cell C1 in workbook2 suppose to show the result of VBA programme that is IF(B1=1,RANDBETWEEN(0,9),"")


When Cell E1 in workbook shows no.1, it will be automatically reflected in Cell A1 of workbook2 because of the link.

The problem is, I am not getting the RANDBETWEEN(0,9) in Cell C1 of workbook 2.

Even if I key in no.1 manually in Cell E1 in workbook1, I am not getting the result in Cell C1 of the workbook2.

When I key in no.1 in Cell A1 in workbook 2 manually, only then I will get the result in Cell C1 of the workbook2.

Can someone solve this problem for me?

I could not run two different macros properly when I run in the same workbook but in different sheets. Even if I open a new page within the same workbook, the clock is being affected.

Therefore, I have to run this programme in TWO different workbooks. The clock has to be in a workbook on it's own without being affected.

Thinking in advance.

[SamT]

You are using OnTime to run this every second. You record the time every second. . . In the same cells for an entire minute. Only then do you change Rows.


At least put all that "Clock" code in a Standard Module, only run it once a minute, (unless you just like to watch the Seconds tick by,) and use Explicit Sheet and Range assignments.

[Patrickwest]

You are using OnTime to run this every second. You record the time every second. . . In the same cells for an entire minute. Only then do you change Rows.


At least put all that "Clock" code in a Standard Module, only run it once a minute, (unless you just like to watch the Seconds tick by,) and use Explicit Sheet and Range assignments.

Need to watch the seconds to make sure the clock is running correctly. Furthermore, I tried with the "Clock" code in a standard Module like what you have mentioned but still could not get the result in workbook2 Cell C1 to C1440. If I use same workbook with different sheets, the clock get disturbed and the number will start to run wild.

I would appreciate if you could explain your recommendation/suggestion in a more simpler way as I have almost no knowledge about VBA programmes and not an expert in Excel. Thanks.

[offthelip]

It would appear to me that what you are trying to do is do some calculations at exactly the time that the seconds tick over from 59 to 60. One of the difficulties of doing this is that PC operating systems are not deterministic, so all sorts of operations can stop things happening at exactly the time that you want them to.
To get this to work you need to minimise what else is running on your computer and you need to minimise the number of calculations that EXCEL needs to do at any one time. Swapping between workbooks is inevitably going to be a slow operation in eXCEL so I believe that to get this to run efficiently you do need to do this in one workbook. If the clock is going wild when you are running in one workbook that is showing you that EXCEL is running out of time.
I have built a considerable number of realtime monitoring systems using EXCEl and getting them to work accurately is not easy. My rules are always use a powerful dedicated machine, stop as many Microsoft services as you possibly can, get everything possible out of the startlist. Only run the excel program absolutely nothing else. Work really hard on minimising the recalculation speed of the workbok. Avoid Volatile functions as much as possible. Best of luck

[offthelip]

I have just spotted a fatal error in your code:
You need to switch off events when you change a cell in the worksheet change event
this is because changing a cell causes the worksheet change event to trigger again so you end in a perpetual loop
do this by putting
application.enable event false/ true around the code that changes the cells

[VBa]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 Then Exit Sub
Application.EnableEvents= False
Cells(Target.Row, 3) = Evaluate("=IF(B" & Target.Row & "=1,RANDBETWEEN(0,9),"""")")
application.Enableevents= True
End Sub[/vba]

[offthelip]

I have been trying to work through what you are trying to do, it is seems that you appear to want to calculate a random number once a minute and put it in column C.
Yopu can do this with your current code quite easily by just adding one line, this will get rid of the second workbook:

[vba] If (Seconds = 60) Then
Cells(CurrentRow, CurrentColumn + 2).Value = Rnd * 9
Minutes = Minutes + 1
CurrentRow = CurrentRow + 1
Seconds = 0

End If


[/vba]

[SamT]

Need to watch the seconds to make sure the clock is running correctly.

That is a mistake. For one thing the scheduled run time is actually the earliest run time. It can run any time after that. This timing error adds up to possible several minutes of error over a day's run. For more info, refer to offthelip's posts.

Try this in a Standard Module in Workbook2

Dim CurrentCell As  Range
Dim Initalised As Boolean 
Dim SchedRecalc as Date
 
Private Sub Recalc() 
         With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
         .EnableEvents = False
         End With

With Sheets("Clock") 'Edit to suit
         CurrentCell = Date
         CurrentCell.Offset(,1) = Time
         Set CurrentCell = CurrentCell.Offset(1)
         
         ' Stop repeating after 24 hours (1440 minutes)
        If CurrentCell.Row> 1440 Then Initalised = False

         With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
         .EnableEvents = True
         End With
 
         SetTime 
 End Sub 

'-----------------------------------------
 
Sub SetTime() 
    If (Not Initalised) Then 
        Initalised = True
 
         With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
         .EnableEvents = False
         End With

         ' Initialise variables.
         Set CurrentCell = Sheets("Clock").Range("C1")
         SchedRecalc = Date + Format(Now, "hh:mm:00") 'Every minute at the minute
         Sheets("Clock").Range("C1:C1440").ClearContents
         CurrentCell = Date
         CurrentCell.Offset(,1) = Time
         Set CurrentCell = CurrentCell.Offset(1)

         With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
         .EnableEvents = True
         End With

   End If 
     
    SchedRecalc = SchedRecalc + TimeValue("00:01:0") 'Every minute at the minute
    Application.OnTime SchedRecalc, "Recalc" 
End Sub

[Patrickwest]

That is a mistake. For one thing the scheduled run time is actually the earliest run time. It can run any time after that. This timing error adds up to possible several minutes of error over a day's run. For more info, refer to offthelip's posts.

Try this in a Standard Module in Workbook2

Dim CurrentCell As  Range
Dim Initalised As Boolean 
Dim SchedRecalc as Date
 
Private Sub Recalc() 
         With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
         .EnableEvents = False
         End With

With Sheets("Clock") 'Edit to suit
         CurrentCell = Date
         CurrentCell.Offset(,1) = Time
         Set CurrentCell = CurrentCell.Offset(1)
         
         ' Stop repeating after 24 hours (1440 minutes)
        If CurrentCell.Row> 1440 Then Initalised = False

         With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
         .EnableEvents = True
         End With
 
         SetTime 
 End Sub 

'-----------------------------------------
 
Sub SetTime() 
    If (Not Initalised) Then 
        Initalised = True
 
         With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
         .EnableEvents = False
         End With

         ' Initialise variables.
         Set CurrentCell = Sheets("Clock").Range("C1")
         SchedRecalc = Date + Format(Now, "hh:mm:00") 'Every minute at the minute
         Sheets("Clock").Range("C1:C1440").ClearContents
         CurrentCell = Date
         CurrentCell.Offset(,1) = Time
         Set CurrentCell = CurrentCell.Offset(1)

         With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
         .EnableEvents = True
         End With

   End If 
     
    SchedRecalc = SchedRecalc + TimeValue("00:01:0") 'Every minute at the minute
    Application.OnTime SchedRecalc, "Recalc" 
End Sub

Dear Mr. Sam,

For some reason, I could not get your programme to run.

Either it is not responding or showing error.

However, I truly appreciate your kind help. Thank you very much.

[Patrickwest]

Dear offthelip,

The earlier suggestion did not work.

The later was fine.

If (Seconds = 60) Then 
    Cells(CurrentRow, CurrentColumn + 2).Value = Rnd * 9 
    Minutes = Minutes + 1 
    CurrentRow = CurrentRow + 1 
    Seconds = 0 
     
End If

It worked according to what I required. However, it is showing in decimals whereas I require whole numbers. I can just format the cells to show the nearest whole number but I would appreciate if you could eliminate the decimals.

Again, thanking you for the great help.

[offthelip]

You can use the "Int" function in VBA to change any number to an integer.

e.g.
[VBA]Cells(CurrentRow,CurrentColumn + 2).value=Int(Rnd *9)[/VBA]

[Patrickwest]

You can use the "Int" function in VBA to change any number to an integer.

e.g.
[VBA]Cells(CurrentRow,CurrentColumn + 2).value=Int(Rnd *9)[/VBA]

Thank you very much.

I will try during the wekends and let you know.

[Patrickwest]

Thank you very much.

I will try during the wekends and let you know.

I tried the programme.

I notice that regardless what time I start the process, the result is always seem to be first 6 followed by 4 and the subsequent numbers are 5 2 2 6 0 6 7 6 0.

I thought it will be truly random each time I start at a new time.

Is there a way to solve this problem?

Thanks.

[Patrickwest]

You can use the "Int" function in VBA to change any number to an integer.

e.g.
[VBA]Cells(CurrentRow,CurrentColumn + 2).value=Int(Rnd *9)[/VBA]

I tried the programme.

I notice that regardless what time I start the process, the result is always seem to be first 6 followed by 4 and the subsequent numbers are 5 2 2 6 0 6 7 6 0.

I thought it will be truly random each time I start at a new time.

Is there a way to solve this problem?

Thanks.

[SamT]

If (Seconds = 60) Then 
Randomize '<<<<<<<<<<<<<<<<
    Cells(CurrentRow, CurrentColumn + 2).Value = Rnd * 9

[Patrickwest]

If (Seconds = 60) Then 
Randomize '<<<<<<<<<<<<<<<<
    Cells(CurrentRow, CurrentColumn + 2).Value = Rnd * 9

Dear Sam T,

I tried for 48hrs and it worked fine.

There is a slight change in requirement which I hope you will help me.

Currently the randomize number is shown in the Cell C1.

The new requirement is:- Cell C1 should show a randomized number between 0 and 7, Cell D1 should show a randomized number between 1 and 8 and the Cell E1 should show a randomized number between 2 and 9. The most important part is Cells C1, D1 and E1 should not show the same number at the same time.

Thanks and Regards

[offthelip]

if you ensure that the cells D1 and E1 are not the same as the number in C1 , they are no longer random numbers. Is this what you want?
If so are you just going to recalculate until you gert on number which isn't the same or what?
To provide different random numbers ( which might end up the same) in cells D1 and E1 is so easy as to be trivial.
Randomize
Cells(currentrow, currentcolumn+2).value= rnd*7
Randomize
Cells(currentrow, currentcolumn+3).value= (rnd*7)+1
Randomize
Cells(currentrow, currentcolumn+4).value= (rnd*7)+2

To ensure the numbers are different you would need to enclose the second and third calculations in do while loops that check for difference to ext

[Patrickwest]

if you ensure that the cells D1 and E1 are not the same as the number in C1 , they are no longer random numbers. Is this what you want?
If so are you just going to recalculate until you gert on number which isn't the same or what?
To provide different random numbers ( which might end up the same) in cells D1 and E1 is so easy as to be trivial.
Randomize
Cells(currentrow, currentcolumn+2).value= rnd*7
Randomize
Cells(currentrow, currentcolumn+3).value= (rnd*7)+1
Randomize
Cells(currentrow, currentcolumn+4).value= (rnd*7)+2

To ensure the numbers are different you would need to enclose the second and third calculations in do while loops that check for difference to ext

I want to be very sure that numbers in Cells C1, D1 and D1 should not be the same and the criteria should continue all the way down to Cells C1440, D1440 and E1440. Meaning, numbers in C1440, D1440 and E1440 should not be the same.

I am sorry I could not understand the last instruction you have provided in the reply.

Thanks and Regards.

[SamT]

Cell C1 will have for example as 00:00:00 (Time). Cell C2 will be 00:01:00 and so on until Cell C1440.

The new requirement is:- Cell C1 should show a randomized number between 0 and 7, Cell D1 should show a randomized number between 1 and 8 and the Cell E1 should show a randomized number between 2 and 9. The most important part is Cells C1, D1 and E1 should not show the same number at the same time.

I want to be very sure that numbers in Cells C1, D1 and D1 should not be the same and the criteria should continue all the way down to Cells C1440, D1440 and E1440.

Since we know that Excel recalculates every time any cell changes, we will want to turn calculltion off until we get all those cells loaded.

To force Excel to use Multiple CPU Cores, we can call function for each set of cells

First the Function

Private Function Make3Random(FirstCell As Range)
'For Speed, do it all in memory first
Dim Randoms(1 to 3) As Double 'Randoms will hold three unique (for that row) random numbers

'Randomizing code = Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
Randomize
Randoms(1) = Int((8) * Rnd ) 

Do while Randoms(1) <> Randoms(2)
Randomize
Randoms(2) = Int((8) * Rnd + 1) 
Loop

Do while Randoms(1) <> Randoms(3) And Randoms(2) <> Randoms(3)
Randomize
Randoms(3) = Int((8) * Rnd + 2) 
Loop

FirstCell.Resize(, 3) = Randoms 'First, change the FirstCell Range into a three cell wide Range
End Function

Now we can loop thru the Rows, Calling the Function for each one.

Sub FillCells()
Dim r As Long

With Application
  .EnableScreenUpdating = False 'Stops Screen Flicker
   .Calculation = xlCaclulationManual 'For Speed
End With

For r = 1 to 1440
'Place any conditions here
Make3Random Cells(r, "C") 'Cells(Row, Column)
Next r

With Application
  .EnableScreenUpdating = True
   .Calculation = xlCaclulationAutomatic
End With
End Sub

[Patrickwest]

if you ensure that the cells D1 and E1 are not the same as the number in C1 , they are no longer random numbers. Is this what you want?
If so are you just going to recalculate until you gert on number which isn't the same or what?
To provide different random numbers ( which might end up the same) in cells D1 and E1 is so easy as to be trivial.
Randomize
Cells(currentrow, currentcolumn+2).value= rnd*7
Randomize
Cells(currentrow, currentcolumn+3).value= (rnd*7)+1
Randomize
Cells(currentrow, currentcolumn+4).value= (rnd*7)+2

To ensure the numbers are different you would need to enclose the second and third calculations in do while loops that check for difference to ext

I made a fatal mistake. Very Sorry and regret for any inconvenience caused. Actually the new requirement supposed to be Cell C1 should be a randomized number between 0 and 7. Cell D1 should be should show a randomized number between (greater than the value in Cell C1) and 8. Cell E1 should show a randomized number between (greater than the value in the Cell D1) and 9. This way it will not show any repeated numbers in any of the cells. All numbers should show as whole numbers.

Thanks.

[Patrickwest]

I made a fatal mistake. Very Sorry and regret for any inconvenience caused. Actually the new requirement supposed to be Cell C1 should be a randomized number between 0 and 7. Cell D1 should be should show a randomized number between (greater than the value in Cell C1) and 8. Cell E1 should show a randomized number between (greater than the value in the Cell D1) and 9. This way it will not show any repeated numbers in any of the cells. All numbers should show as whole numbers.

Thanks.