0

I have an Excel workbook.

It has a powerquery connected to an API which refreshes with new data every minute.

I then have another sheet that is static, with a macro that copies the data from the dynamic sheet to the first available row on the static sheet, and is set to run at 1.5 minute intervals.

My question is how I could edit this code to realize that the sheet is full, to start a new sheet and continue the operation. Alternatively, please feel free to call me out on using excel to do this, any better alternatives welcome!

The code for the macro is below:

Public interval As Double
Sub CopyLive_toStatic()
'
' CopyLive_toStatic Macro
' Copy Data from Live Query to Static Table

Sheets("_api_key-xyz").Select
Range("A2:O2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Call macro_timer
End Sub

Sub macro_timer()

'Tells Excel when to next run the macro.
Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"

End Sub

At the moment i am stuck, I have tried google to no avail. Hoping someone with more experience in VBA or similar problems may come to the rescue!

Brian Tompsett - 汤莱恩
  • 5,753
  • 72
  • 57
  • 129
rzan3
  • 1
  • 1
    Check the [row](https://learn.microsoft.com/en-us/office/vba/api/excel.range.row) of the last cell? Side note: In general, you want to [avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code – cybernetic.nomad Jul 13 '23 at 15:31
  • 1
    Seems like you might be better off writing the content to a file, instead of filling multiple sheets? Hard to make better suggestions without knowing what the overall use case is here. – Tim Williams Jul 13 '23 at 16:20
  • If you are at the very bottom of the sheet `Range("A1").End(xlDown).Offset(1, 0).Select` generates an error. – Black cat Jul 13 '23 at 20:13

3 Answers3

1

I would try counting rows to be pasted and place left (it should do the trick assuming, that in single batch to be copied there will be no more rows than 1048576).

Public interval As Double
Sub CopyLive_toStatic()
'
' CopyLive_toStatic Macro
' Copy Data from Live Query to Static Table

    Dim lastRow As Integer
    Dim rowsLeft As Integer

'   Check space left & rows to be copied
    Sheets("_api_key-xyz").Select
    lastRow = Sheets("_api_key-xyz").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = Sheets("Sheet" & ActiveWorkbook.Worksheets.Count).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = 1048576 - rowsLeft
    
'   Copy cells
    Range("A2:O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
'   Check if enough space & add new worksheet if needed
    If lastRow < rowsLeft Then
        ThisWorkbook.worksheets.Add.Name
        activeworksheet.Name = ThisWorkbook.Worksheets.Count
    End If

'   Paste data
    Sheets("Sheet" & ActiveWorkbook.Worksheets.Count).Select
    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Call macro_timer
End Sub

Sub macro_timer()

'Tells Excel when to next run the macro.
Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"

End Sub

Nevertheless, I would be concerned that this will not work, if there will be more than maximum rows in query - it uploads all search result each time, so you have to also add few lines editing the query to exclude already copied rows, but you would have to paste query details to get help with this.

Bart
  • 36
  • 5
0

enter image description here
You would know better but I must note that if the API refreshes with new data every minute and you run the routine every minute and a half, you are bound to lose some of the data in between.
To create a new sheet if a line limit is exceeded, I suggest the following:
You will create a Book scope Named range with value: the name of the original sheet you are copying to, eg ="Sheet1". In my example I call this Name: "CURRENTSHEET", as you will see in the attached image. Now every time CopyLive_toStatic is executed it will read the name of the sheet from "CURRENTSHEET" and check if the records to be added will exceed the limit, if not, we do the copy, if yes then we create a new sheet, save its name to "CURRENTSHEET" and proceed to copy. In the code I avoid Selection and Select and instead of Paste I copy directly. The limit that determines when a sheet is full is defined by changing the value in the statement
Const MAX_ALLOWED_ROWS = 500000.
Each block of records will either be copied to the current sheet, or if it does not fit, it will be copied entirely to the new sheet.

Option Explicit

Public Sub CopyLive_toStatic()
   '
   ' CopyLive_toStatic Macro
   ' Copy Data from Live Query to Static Table
   Dim destWs As Worksheet, curDestSheetName As String, srcRng As Range, destCell As Range, rngToCopy As Range
   Const MAX_ALLOWED_ROWS = 1010000, QUOT = """"
   
   Set srcRng = Worksheets("_api_key-xyz").Range("A2:O2")
   Application.CutCopyMode = False
   Set rngToCopy = Worksheets("items").Range(srcRng, srcRng.End(xlDown))
   curDestSheetName = Application.Evaluate(ThisWorkbook.Names("CURRENTSHEET").value)
   Set destWs = Worksheets(curDestSheetName)
   Set destCell = destWs.Cells(destWs.rows.CountLarge, "A").End(xlUp).Offset(1, 0)
   If destCell.row + rngToCopy.rows.CountLarge > MAX_ALLOWED_ROWS Then
      Set destWs = ThisWorkbook.Worksheets.Add(, destWs)
      Set destCell = destWs.Range("A1")
      curDestSheetName = destWs.Name
      ThisWorkbook.Names("CURRENTSHEET").value = "=" & QUOT & destWs.Name & QUOT
   End If
   rngToCopy.Copy (Worksheets(curDestSheetName).Range(destCell.Address))
   Call macro_timer
End Sub

Sub macro_timer()
   ' Tells Excel when to next run the macro.
   Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"
End Sub
0

In this modification the followings are added

  • If only one row to copy
  • Full table issue (see comment)
  • Continuous new sheet generation

Try it

Sub CopyLive_toStatic()
'
' CopyLive_toStatic Macro
' Copy Data from Live Query to Static Table

'Sheets("_api_key-xyz").Select
Range("A2:O2").Select
If IsEmpty(Range("A3")) Then
Else
    Range(Selection, Selection.End(xlDown)).Select
End If
copyrows = Selection.Rows.Count
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
actcell = Selection(1).Address
actrow = Range(actcell).Row
If actrow + copyrows > Rows.Count Then
Set newsh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
newsh.Range("A1").PasteSpecial
newsh.Range("1:" & Rows.Count - actrow).Copy Destination:=Sheets("Sheet1").Range(actcell).Offset(1)
newsh.Range("1:" & Rows.Count - actrow).Delete
ttime = Time
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, ":"), 1, "")
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, ":"), 1, "")
Sheets("Sheet1").Name = "Sheet1_" & ttime
newsh.Name = "Sheet1"
Else
ActiveCell.Offset(1).PasteSpecial
End If

Call macro_timer
End Sub
Black cat
  • 1,056
  • 1
  • 2
  • 11