Macro to run every 5 seconds until manual stopped

[Rubber Beaked Woodpecker]

I have a macro that I need to run every 5 seconds until I manually need to stop the macro.

I have been playing around with Application on time method but no joy

The code is as following:

Sub logBalance()
 
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet8")
Set destination = Sheets("Sheet1")



source.Range("D556:D567").Copy
destination.Range("O5:O16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

source.Range("D543:D554").Copy
destination.Range("Y5:Y16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
              

source.Range("D540:D567").Copy

emptyColumn = destination.Cells(2, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("Z2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(2, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
      
End If

destination.Range("X4:X44").Copy

emptyColumn = destination.Cells(31, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("Z31")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(31, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
     source.Range("D540:D567").Delete Shift:=xlToLeft
     
 End If
End Sub

On advice on how to achieve this please.

Many thanks
RBW

 

[Rubber Beaked Woodpecker]

Also I keep getting the error 'code execution has been interrupted'

Sure the code was working fine beforehand, any ideas pls?

RBW

*the code is now fixed something to do with ctrl+ break key i think

​

 

[Rubber Beaked Woodpecker]

Ok so it has been a learning day!

I've finally managed to get the code to work and have added a few extra bits but it is not very kind on my pc CPU that is running at 80%!

Any suggestions on how to improve the efficiency of this code please?

Sub logBalance()
   
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet8")
Set destination = Sheets("Sheet1")


source.Range("D556:D567").Copy 
destination.Range("O5:O16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

source.Range("D543:D554").Copy
destination.Range("Y5:Y16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
              

source.Range("D540:D567").Copy 

emptyColumn = destination.Cells(2, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("Z2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(2, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
      
End If

destination.Range("X4:X44").Copy 

emptyColumn = destination.Cells(31, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("Z31")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(31, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    
    
    source.Range("D540:D567").Copy 

emptyColumn = source.Cells(28, source.Columns.Count).End(xlToLeft).Column

If IsEmpty(source.Range("A28")) Then
    source.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    source.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
  source.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteFormats
    
    End If
    
        
     source.Range("D540:D567").Delete Shift:=xlToLeft
     
    Call Repeat
     
 End If
End Sub

Sub Repeat()

RunTimer = Now + TimeValue("00:00:01")

Application.OnTime RunTimer, "logBalance"
Call logBalance
End Sub

 

[Logit]

Dim TimeToRun

Sub StartMacroTimer()
    TimeToRun = Now + TimeValue("00:00:05")
    Application.OnTime TimeToRun, "RunYourMacro"
End Sub

Sub RunYourMacro()

    'paste your macro code here

    Call StartMacroTimer
End Sub

Sub MacroStopIt()
    On Error Resume Next
    Application.OnTime TimeToRun, "RunYourMacro", , False
End Sub

Create two CommandButtons on your worksheet. First one connected to StartMacroTimer and the second one connected to MacroStopIt

 

[Rubber Beaked Woodpecker]

Dim TimeToRun

Sub StartMacroTimer()
    TimeToRun = Now + TimeValue("00:00:05")
    Application.OnTime TimeToRun, "RunYourMacro"
End Sub

Sub RunYourMacro()

    'paste your macro code here

    Call StartMacroTimer
End Sub

Sub MacroStopIt()
    On Error Resume Next
    Application.OnTime TimeToRun, "RunYourMacro", , False
End Sub

Create two CommandButtons on your worksheet. First one connected to StartMacroTimer and the second one connected to MacroStopIt

Brilliant thank you very much

 

[Logit]

You are welcome. Trust it solves your issue.

 

[Rubber Beaked Woodpecker]

You are welcome. Trust it solves your issue.

Yes perfectly

I was pasting the code in a sheet rather than a module

Out of interest and please forgive my ignorance why must this be in a module please?

 

[Logit]

Copy a macro module to another workbook

I am self-taught with some reading into the subject of Excel / Macros / Programming. I cannot answer your question with any authority.

My thoughts have always been, if the macro code relates to a specific SHEET and not anything else, place the code in the SHEET level module.
If the code can be utilized anywhere in the workbook, place the code in a ROUTINE MODULE level module. And, if the macro relates to running at
the very beginning of opening the workbook or the last thing just prior to closing ... place the code in THISWORKBOOK MODULE.

I would be interested in hearing from others (with a formal degree in Excel) the reasonings.

Thanks