Adding New Line to Bottom of Each Sheet Daily

[Wezoin]

Hello everyone,

I have been put in charge of preparing an Excel book for work (despite very limited ability) and have managed to automate a great deal of the process. The book has about 34 sheets, each requiring one row added per day. I have done some perusing on this forum, and found some stuff that has been helpful, but I'm still missing the mark. When I run this code, it starts at 1901 rather than yesterday (which is when the last entries were done).

The code I'm using to add the extra line is:

Private Sub Workbook_Open()

    Dim lastDate As Date
    
'   Go to the first sheet
    Sheets("Aggregate - Europe").Activate
    
'   Check the first value
    lastDate = Range("A" & Rows.Count).End(xlUp)
    If lastDate < Date Then
        Do Until lastDate = Date
            lastDate = Range("A" & Rows.Count).End(xlUp).Select
            ActiveCell.EntireRow.Insert
            lastDate = lastDate + 1
            Range("A" & Rows.Count).End(xlUp) = lastDate
        Loop
    End If
    
End Sub

I adapted it from this thread: How to add new row each day automatically?
Using this video to try to flip it to add rows to the end:

My intent was to get one sheet working before trying to integrate the next sheet code, but I'm not sure how to integrate that into the loop either. The code I found to select next sheet is:

Sub SelectNextSheet()

Dim sht As Worksheet

'Store currently selected sheet
  Set sht = ActiveSheet

'Loop to next sheet until visible one is found
  On Error Resume Next
    
    Do While sht.Next.Visible <> xlSheetVisible
      If Err <> 0 Then Exit Do
        Set sht = sht.Next
    Loop
    
    'Activate/Select next sheet
      sht.Next.Activate
  
  On Error GoTo 0

End Sub

I found this on: VBA Code To Select Next & Previous Spreadsheet Tabs — The Spreadsheet Guru

Could somebody please help me get this working? I'm not sure where I am going wrong.

 

[Zack Barresse]

What is the data in column A? I wouldn't do this with a loop, but in one fell swoop. Would help to know what you have on the grid though.

 

[Wezoin]

Hi Zack,

Column A is a set of dates in this format:

2020-04-07

 

[Zack Barresse]

Can you Table your data? It becomes very simple if you do so. Something like...

Table.ListRows.Add

Regarding your data, the code you have inserts a line above the last line of data. Yet, you're setting your date value to the last line of data as well. This is a little confusing. If you could post your data it would help understand your needs.

Regarding the next/previous issue, the code you have is decent, however, I use something different to include next/previous as a parameter.

Sub SelectNextSheet( _
    Optional ByVal Direction As XlSearchDirection = xlNext _
    )
   
    Dim Sheet As Worksheet
    Dim NextSheet As Worksheet
   
    If ActiveSheet Is Nothing Then Exit Sub
    On Error Resume Next
    Set Sheet = ActiveSheet
   
    If Direction = xlNext Then
        If Sheet.Next Is Nothing Then Exit Sub
        Do While Sheet.Next.Visible <> xlSheetVisible And Not Sheet.Next Is Nothing
            Set Sheet = Sheet.Next
        Loop
        Sheet.Next.Activate
    Else
        If Sheet.Previous Is Nothing Then Exit Sub
        Do While Sheet.Previous.Visible <> xlSheetVisible
            Set Sheet = Sheet.Previous
        Loop
        Sheet.Previous.Activate
    End If

End Sub

 

[Wezoin]

Private Sub Workbook_Open()

    Dim lastDate As Date
    
'   Go to the first sheet
    Sheets("Aggregate - Europe").Activate
    
'   Check the first value
    lastDate = Range("A" & Rows.Count).End(xlUp)
    If lastDate < Date Then
        Do Until lastDate = Date
            Table_3.Table.ListRows.Add
            lastDate = lastDate + 1
            Range("A" & Rows.Count).End(xlUp) = lastDate
        Loop
    End If
    
End Sub

Like this? I'm getting Runtime 424 errors when I try it.

2020-04-03	595005	424905	106506	45866	7.71%	5.26%​	-18.53%​
2020-04-04	652676	447180	119112	50531	7.74%	5.24%​	-0.31%​
2020-04-05	688337	486131	128026	54174	7.87%	8.71%​	66.15%​
2020-04-06	719056	522168	136967	57980	8.06%	7.41%​	-14.89%​
2020-04-07	738174	523516	147696	62964	8.53%	0.26%​	-96.52%​

This is a selection of the data, other than the date each piece has a formula to pull it from another Excel sheet, which works fine.

 

[Zack Barresse]

I'm confused. Do you have a Table? What is "Table_3.Table"? Is it a Table? If so, what worksheet is it housed in? If your data is not in a Table, do you have a row under your data, like a totals row?

 

[Wezoin]

There is no totals row, Table_3.table is a table, housed on the Aggregate - Europe worksheet.

 

[Zack Barresse]

Ok, great! What is the date column name?

 

[Wezoin]

3.table is a table, ho

Hi Zack, Thanks for your help, I very much am out of my depth here. The date column is just called 'Date'

 

[Zack Barresse]

I would use something like the below code, since it's a Table.

Private Sub Workbook_Open()

    Dim Sheet As Worksheet
    Dim Table As ListObject
    Dim DateColumn As ListColumn
    Dim Index As Long
    Dim LastDate As Date
    Dim LastEmptyDateRow As Long
    Dim AddRowCount As Long
    Dim NewRowCount As Long
    Dim Values As Variant
    
    Set Sheet = Sheets("Aggregate - Europe")
    Set Table = Sheet.ListObjects("Table_3")
    Set DateColumn = Table.ListColumns("Date")
    
    Application.ScreenUpdating = False
    
    Table.Sort.SortFields.Clear
    Table.Sort.SortFields.Add2 Key:=DateColumn.Range, SortOn:=xlSortOnValues, Order:=xlAscending
    Table.Sort.Header = xlYes
    Table.Sort.Orientation = xlTopToBottom
    Table.Sort.Apply
    
    LastDate = WorksheetFunction.Max(DateColumn.Range)
    If LastDate = Date Then Exit Sub
    NewRowCount = Date - LastDate
    LastEmptyDateRow = Table.ListRows.Count
    
    Do Until Len(DateColumn.DataBodyRange(LastEmptyDateRow, DateColumn.Index).Value) <> 0
        LastEmptyDateRow = LastEmptyDateRow - 1
    Loop
    
    Table.Resize Table.Range.Resize(Table.ListRows.Count + NewRowCount - (Table.ListRows.Count - LastEmptyDateRow) + 1)
    AddRowCount = Table.ListRows.Count - LastEmptyDateRow - NewRowCount
    ReDim Values(0 To NewRowCount - 1)
    For Index = 0 To UBound(Values)
        Values(Index) = LastDate + Index + 1
    Next Index
    
    DateColumn.DataBodyRange(LastEmptyDateRow + 1).Resize(NewRowCount).Value = Application.Transpose(Values)
    
    Application.ScreenUpdating = True
    
End Sub

Basically, instead of doing a ton of loops, we insert the number of rows needed, then dynamically populate it with the last date. This does need to have sorted data in the 'Date' field, which the code also does. If I've understood you correctly, this should do the trick.

If you want this performed on each Table in each worksheet, you need to give more information, such as if the Tables are the only one's on the worksheet, or a list of worksheet/table names. We can utilize a Table name (preferably knowing the sheet it's housed on) or Table index (index number, by worksheet).