Continuous Macro error

[Rubber Beaked Woodpecker]

Hi all

I've been using the following code that repeats its self continuously until stopped. I was hoping that I would be able to stop the by pressing the escape key. Alas this doesn't work but pressing ctrl + pause/break does stop the code. However this then creates an error.

This is a link to the sheet with the data removed from the sheet leaving the vba code only.

Test Sheet.xlsm

Shared with Dropbox

www.dropbox.com

The code is as follows;

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

Hopefully some kind soul can point me in the right direction on this

Many thanks

RBW

 

[Rubber Beaked Woodpecker]

This is now fixed Sheet is working

 

[smozgur]

Good to hear it is fixed.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

 

[Rubber Beaked Woodpecker]

Good to hear it is fixed.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

Ok sorry.

Code was in sheet 1. Moved to a module and it works fine.

Beyond my knowledge why that is guess I need to read-up.