VBA to copy data from area and insert this data to an Excel Table

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.

rTime = Now + TimeValue("00:00:15")
 
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("Pivot").Select
Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

' ##### Select the sheet containing the table Tbl_Summarized #####
 Sheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Selection.End(xlToRight).Select
    Dim newRow As ListRow
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=False)
    newRow.Range.Select
    ActiveSheet.Paste
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Select allOpen in new window

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date
Dim rwInMax As Long
Dim rwIn As Long


Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    Cells(1, 1).Value = Cells(1, 1).Value + 1

    Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects("Tbl_Summarized")
        Worksheets("Pivot").Range("A6").CurrentRegion.Copy

        Set oRw = oTbl.ListRows.Add(AlwaysInsert:=True)
        Range.Cells(1, 1).PasteSpecial xlValues

        rwInMax = oTbl.ListRows.Count
        'not sure what you are doing here
        For rwIn = 3 To rwInMax - 1    'rwInMa otbl.x      'repeat until you reach the bottom of the sourcesheet or actually the datarange set

            If IsEmpty(.Range("H" & (rwIn))) Then

                If Not IsEmpty(.Range("A" & (rwIn))) Then

                    .Range("H" & (rwIn)) = Format(Now, "hh:mm:ss")

                Else

                End If

            Else

            End If

        Next rwIn
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True


    If Cells(1, 1).Value > 1 Then

        Application.OnTime rTime, "CellValueAutoIncr1", , False

    End If

End Sub

Select allOpen in new window

orw.Range.Cells(1, 1).PasteSpecial xlValues

Select allOpen in new window

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.

rTime = Now + TimeValue("00:00:15")
 
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("Pivot").Select
Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

' ##### Select the sheet containing the table Tbl_Summarized #####
 Sheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Dim newRow As ListRow
    ' The next line works with AlwaysInsert:=False. Changing this to True breaks cancels the copy therefore breaking the paste
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=False)
    newRow.Range(1, 1).Select
    ActiveSheet.Paste
    ' Assuming timestamp goes in the eighth column of the table
    newRow.Range.Cells(1, 8).Select
    ' ***** The next line will cause trouble if only a single row was pasted
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = Format(Now, "hh:mm:ss")
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Select allOpen in new window

 oTbl.ListColumns(8).SpecialCells(xlCellTypeBlanks).Value = Format(Time, "hh:mm:ss")

Select allOpen in new window

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    Cells(1, 1).Value = Cells(1, 1).Value + 1

    Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects("Tbl_Summarized")
        Worksheets("Pivot").Range("A6").CurrentRegion.Copy

        Set oRw = oTbl.ListRows.Add(AlwaysInsert:=True)
        oRw.Range.Cells(1, 1).Resize(, 7).PasteSpecial xlValues
        oTbl.ListColumns(8).SpecialCells(xlCellTypeBlanks).Value = Format(Time, "hh:mm:ss")
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Select allOpen in new window

Sub CellValueAutoIncr1a()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow
    Dim Rws As Integer

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    '    Cells(1, 1).Value = Cells(1, 1).Value + 1

    '    Worksheets("Dataload").Select
    '    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    '    Worksheets("Pivot").Select
    '    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh
    '
    '    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    '    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects(1)

       With Worksheets("Pivot")
       Rws = .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Rows.Count
        .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Copy oTbl.ListRows(1).Range.Resize(Rws, 7)
             
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Select allOpen in new window

Sub CellValueAutoIncr1a()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow
    Dim Rws As Integer

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    '    Cells(1, 1).Value = Cells(1, 1).Value + 1

    '    Worksheets("Dataload").Select
    '    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    '    Worksheets("Pivot").Select
    '    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh
    '
    '    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    '    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects(1)
    End With
    With Worksheets("Pivot")
        Rws = .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Rows.Count
        .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Copy oTbl.ListRows(1).Range.Resize(Rws, 7)

    End With


    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Select allOpen in new window

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()

    Dim newRow As ListRow

'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.
'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.
'set the time interval at 15 seconds, at which interval the procedure will run.
rTime = Now + TimeValue("00:00:15")
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
    Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

' ##### Select the sheet containing the table Tbl_Summarized #####
Worksheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
    newRow.Range(1, 1).Select
    
Worksheets("Pivot").Select
Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
Worksheets("Dagens summerede Data").Select
    ActiveSheet.Paste
    ' Assuming timestamp goes in the eighth column of the table
    newRow.Range.Cells(1, 8).Select
    ' ***** The next line will cause trouble if only a single row was pasted
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = Format(Now, "hh:mm:ss")
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Select allOpen in new window