Macro for auto monthy update

[ExcelFind]

Hello,

Can you help me out with a macro that only updates data in a table in case of a new month?

• The data is automatically updated via a macro in columns AF1:AL1 (orange numbers)
• In case current month+year = last populated month+year: nothing should happen
• Only in case of a new month the script should to the following:
  • Add the next month with year (format MM/YY) at the end of column AE (extending the table)
  • Copy values AF1:AL1 to the new added row for the new month (AFx:ALx)

In the example below the macro should add month 04/23 in cell AE12 and copy/paste values AF1:AL1 to AF12:AL12.

 

[OaklandJim]

Unfortunately I do not understand what is to be done.

First, where does orange data come from (or how does it get there)? And when is it put there?

Second, what triggers the update? Do you want to look for a new month when the workbook is opened? Should there be a button that calls VBA that determines whether there is a new month?

Why can't you just add the data to the bottom of the table? Seems easy enough.

 

[ExcelFind]

Hello OaklandJim,

Understandable, I was indeed a bit too fast without further explaining the background.

1. The user will use a script button to update the entire Excel workbook with data from an external database (I didn't include the whole script as it is not relevant for this specific question).
2. After the update, the orange data comes from pivot tables and the final step of the script should be to add a new week number in the table and paste the orange data in the added row.

This final step should only be performed by the script in case the last populated data was from previous week (and not equal to the current week).
So if the user is updating the entire workbook twice in the same week, the script should not add a new row with the same week number in the table.
In the example above I just showed one table as an example, but this code will be used in order to update many more tables in the workbook.

Let me know if something is not clear. Thank you,

 

[OaklandJim]

This is confusing. First in the initial post you say

Add the next month with year (format MM/YY) at the end of column AE (extending the table)

Then in response you say

add a new week number in the table and paste the orange data in the added row

It seems that it is month/year that is added not "new week"?

Anyway, the macro should merely add the orange data to the bottom of the table -- extending the table range by one row -- if the current month/year is after the most recent data in the last row in the table?

There may be an issue...what if user does not update data in a given month. Then the orange data could be posted as being from the wrong month. Example: 1. current month is 06/23, 3. orange data is from 05/23, 3. most recent data is for 04/23. Orange data would be posted as being from 06/23. Ideally orange data has the correct month.

Please consider posting your data using Mr. Excel's excellent XL2BB add-in. See HERE.

 

[OaklandJim]

Ideally, when using VBA to update the table, the data table has a name. What should it be? Also, what is the orange data? Sales? Hours? I normally give a name to data that is being used. What is the name of worksheet containing the table?

 

[OaklandJim]

After re-reading your post I see that there is more than one worksheet with a table in it. How many worksheets? Is there a theme to naming the sheets like Department 1, Department 2 etc. or Sales 1, Sales 2 etc.?

If the tables are named, what name did you give to them? Are the table names consistent with the way the worksheets are named such as TableSales1, TableSales2, etc.?

To name a table click on it and see the Table Design menu item. To the left of the ribbon you can name the table.

From my previous post -- what are the data being added? Is it sales, hours, etc.?

 

[ExcelFind]

It seems that it is month/year that is added not "new week"?

Correct, this should be month/year not week.

There may be an issue...what if user does not update data in a given month. Then the orange data could be posted as being from the wrong month. Example: 1. current month is 06/23, 3. orange data is from 05/23, 3. most recent data is for 04/23. Orange data would be posted as being from 06/23. Ideally orange data has the correct month.

The script first updates all data in the entire workbook, the orange data is always reflecting the data of the current date (or current month). Condition: the report should be updated at least every month, otherwise the data of the skipped month will not be added in the table.

Ideally, when using VBA to update the table, the data table has a name. What should it be? Also, what is the orange data? Sales? Hours?

For this example you can use it Table1, I will update the code accordingly as there are tables in this workbook. The orange data is reflecting sales in this example.

I am using the below script as this moment, however if the report is updated twice in the same month the same month will be added again in the table.

Sub update()
'
' Update monthly Macro

Range("AN4").Select
Selection.Copy
Range("AE4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF1:AK1").Select
Selection.Copy
Range("AE4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

 

[OaklandJim]

Oy, you did not mention that the date is in cell AN4! Anyway, here is a "structured" rewrite of your code that is a bit easier to decipher/read. Note that it is often not necessary to .Select so much. In fact .Select can most often be avoided. Better programming. Faster (although speed is not a challenge here."

Anyway, this code seems to do what yours did.

Sub CopyNewDataToTable()
'
'   -------- Copy/Paste Date ---------

'   Apparently the date for "new" data is in cell AN4?
    ActiveSheet.Range("AN4").Copy
  
'   Offset 1 refers to cell in column AE that is one row below the most
'   recent (last) data row in the table. Put date there.
    ActiveSheet.Range("AE4").End(xlDown).Offset(1).PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
  
'   -------- Copy/Paste New Data ---------
  
'   Copy New data
    ActiveSheet.Range("AF1:AL1").Copy

'   Offset(0, 1) refers to cell in column AF, one row below the
'   most recent (last) data row in the table.
    ActiveSheet.Range("AE4").End(xlDown).Offset(0, 1).PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
      
    Application.CutCopyMode = False
  
'   Leave user in table cell containing latest date
    ActiveSheet.Range("AE4").End(xlDown).Activate
  
End Sub

Your latest picture of the worksheet says: "Orange example data is first updated by the same script."

Huh? Does that mean that you were hoping for code that gets the "new" date and data before it is put into the table? But, I have no idea where that data comes from and how it gets there. My code assumes that the "new" data is already there!

Unfortunately, because the spec you gave for the task did not specify that the date is in AN4 I wrote code that determines the "next" month/year after the last row's date month/year. That code always uses that "next" month/year rather than the date specified in AN4. So I'll have to rewrite. It'll take a while.

Also, why not put the date in cell AE1

So I am clear...in all cases
1. the table will have the same number of columns (AE:AL),
2. the upperleftmost cell in the table is always AE3?
3. "new data is always in cells/range AE1:AL1?
4. date is always in AN4?

Will the table width contract or expand to accommodate a change of staffing (fewer/more names)?

 

[OaklandJim]

The workbook is HERE. I can only do so much testing as I do not have the real data.

Here is the main sub that "loops" through all sheets to be processed.

Option Explicit
Option Base 1  '<= so arrays do not start at element zero.

' ----------------------------------------------------------------
' Procedure Name: TransferDataInWorksheets
' Purpose: Transfer data from range to table in specified sheets.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 4/13/2023
' Note: Transfers done are in the workbook containing this code (ThisWorkbook).
' ----------------------------------------------------------------

'This sub processes all sheets in which transfer of new data will occur.

Sub TransferDataInWorksheets()

    Dim wsToProcess As Worksheet
   
    Dim iSheetsToProcessCount As Long
   
    Dim iSheet As Long
   
'   Array containing 1. sheet name, 2. "data from" range name or cell address (in the sheet),
'   3. table name (in the sheet) for each sheet to be processed.
    Dim asSheetsData() As String
   
'   Count of sheets to process
    iSheetsToProcessCount = 2  '<= change to number of sheets to process.
   
'   Size the array to accommodate 3 data points for each sheet to process.
'   First array dimension is for 1. sheet name, 2. range name or address, 3. table name.
    ReDim asSheetsData(3, iSheetsToProcessCount)
   
'   For each sheet to process need entries in the array like the following two.
   
'   ~~~ Sheet 1 ~~~
    asSheetsData(1, 1) = "Source2"   '<= name of first sheet to process
    asSheetsData(2, 1) = "AF1"       '<= cell location of first (leftmost) new data value
    asSheetsData(3, 1) = "Table3"    '<= name of table to process in the first sheet to process
   
'   ~~~ Sheet 2 ~~~
    asSheetsData(1, 2) = "Source3"
    asSheetsData(2, 2) = "AF1"
    asSheetsData(3, 2) = "Table4"
   
    For iSheet = 1 To iSheetsToProcessCount
   
'       Check for sheet specified exists.
        If Not WorksheetExists(asSheetsData(1, iSheet)) _
         Then
            MsgBox "The worksheet named " & asSheetsData(1, iSheet) & " does not exist.", vbExclamation
       
        Else 'The specified worksheet exists.
           
            Set wsToProcess = ThisWorkbook.Worksheets(asSheetsData(1, iSheet))
           
'           Check valid address or range name exists in the sheet being processed. If not tell user.
            If Not IsValidCellAddress(asSheetsData(2, iSheet)) _
            And Not RangeNameExistsInSheet(asSheetsData(2, iSheet), wsToProcess) _
             Then
                MsgBox "Range " & asSheetsData(2, iSheet) & " does not exist in sheet named " & wsToProcess.Name & ".", vbExclamation
           
            Else 'range name or address is valid.
            
'               Check table exists in the sheet being processed. If not tell user.
                If Not TableExistsInSheet(asSheetsData(3, iSheet), wsToProcess) _
                 Then
                    MsgBox "Table " & asSheetsData(3, iSheet) & " does not exist in sheet named " & wsToProcess.Name & ".", vbExclamation
               
                Else
                    
'                   If worksheet, range and table exist then do the transfer of "new" data to the
'                   table unless there is no "new" data.

'                   Check for "new" data exists. If not tell user.
                    If wsToProcess.Range(asSheetsData(2, iSheet)).Value = "" _
                     Then
                        MsgBox "No new data exists in the sheet named " & wsToProcess.Name & ".", vbExclamation
                   
                    Else
'                       Transfer new data to the table. Parameters are 1. the worksheet sheet
'                       (object) to process, 2. range (object) where "new" data exists, and
'                       3. the table (object) where "new" data is copied into.
                       
                        Call TransferDataToTable( _
                            wsToProcess, _
                            wsToProcess.Range(asSheetsData(2, iSheet)), _
                            wsToProcess.ListObjects(asSheetsData(3, iSheet)))
                    End If
               
                End If
               
            End If
       
        End If
           
    Next iSheet
   
End Sub

This code does the actual data transfer for one sheet.

' ----------------------------------------------------------------
' Procedure Name: TransferDataToTableMY
' Purpose: Transfer month/year data from source range into specified table in specified sheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter pwsSheet (Worksheet): Worksheet (object) to be processed.
' Parameter prRangeToCopy (Range): Range (object) from data is transferred from.
' Parameter poTable (Object): Table object where data is transferred to.
' Author: Jim
' Date: 4/13/2023
' ----------------------------------------------------------------

Sub TransferDataToTable(pwsSheet As Worksheet, prRangeToCopy As Range, poTable As Object)

'   --------------------------
'         Declarations
'   --------------------------

'   Cell in the worksheet where the date for new data is located.
    Dim rDateCell As Range

'   Range object that will point to the existing table's cells range.
    Dim rTable As Range

'   Cells range where data is transferred to ("new" row in the table).
    Dim rRangeForPaste As Range
   
'   Count of table rows and columns.
    Dim iTableRows As Long
    Dim iTableCols As Long
   
'   ----------------------------
'         Initializations
'   ----------------------------

'   Cell containing the date for the new data.
    Set rDateCell = pwsSheet.Range("AN4")  '<= assume date is always in cell AN4.

'   Range where table is located.
    Set rTable = poTable.Range

'   Count rows in the table before adding one and transferring data.
    iTableRows = rTable.Rows.Count

'   Count of columns in the table -- assume "new" data has the same
'   number of cells (width) as the table does.
    iTableCols = rTable.Columns.Count

'   Range of cells which "new" data is transferred FROM.
    Set prRangeToCopy = prRangeToCopy.Cells(1).Resize(1, iTableCols - 1)

'   Cells range into which data is transferred.
    Set rRangeForPaste = rTable.Cells(iTableRows + 1, 2).Resize(1, iTableCols - 1)
   
'   ---------------------------------------------
'          Copy the "New" Data To the Table
'   ---------------------------------------------

'   Transfer the "new" data TO the table in a new table row. Like copy/paste values.
'   FYI, doing this adds a row at the bottom of the table "automatically" (includes
'   formatting such as date formatted MM/YY.
    rRangeForPaste.Value = prRangeToCopy.Value
   
'   Put the date into the first cell in the row for "new" data.
'   Offset(0, -1) means one to the left of the first cell with new data.
       
    rRangeForPaste.Cells(1).Offset(0, -1).Value = rDateCell.Value
       
'   => Add this code if the new date and data should be cleared after
'   => transfer (copy) to the table. Seems like a good idea...so that
'   => the same data is not transferred to the table twice. Remove the two
'   => single quote marks to implement.

'   Clear the data in 1. the cell containing the "new" date and
'                     2. the range containing the "new" data.
'    rDateCell.Value = ""
'    rRangeToCopy.Value = ""

End Sub

Functions used to determine if 1. a specified worksheet exists, 2. the specified named range exists, 3. the cell address specified for the first (leftmost) data value to transfer is valid, and 4. the specified named table exists in the worksheet to be processed.

Function WorksheetExists(psSheetName As String, Optional pwbTarget As Variant) As Boolean

    Dim wsLoop As Worksheet

    Dim wbToProcess As Workbook
   
    If IsMissing(pwbTarget) _
     Then
        Set wbToProcess = ThisWorkbook
    Else
        If TypeName(pwbTarget) <> "Workbook" _
         Then
            Set wbToProcess = ThisWorkbook
        Else
            Set wbToProcess = pwbTarget
        End If
       
    End If
   
    WorksheetExists = False
   
    For Each wsLoop In wbToProcess.Worksheets  '<= chokes

        If wsLoop.Name = psSheetName Then

            WorksheetExists = True

            Exit Function

        End If

    Next wsLoop

End Function

'Not applicable if cell address is used to indicate where "new" data exists.
Function RangeNameExistsInSheet(psRangeName As String, pwsTarget) As Boolean

    Dim nmLoop As Name

    Dim wsToProcess As Worksheet
   
    Dim iLen As Long
   
    Dim ExclamationCharNum As Long
   
    Dim sNameNoSheet As String
   
    If IsMissing(pwsTarget) _
     Then
        Set wsToProcess = ActiveSheet
    Else
        If TypeName(pwsTarget) <> "Worksheet" _
         Then
            Set wsToProcess = ActiveSheet
        Else
            Set wsToProcess = pwsTarget
        End If
       
    End If
   
    RangeNameExistsInSheet = False
   
    For Each nmLoop In wsToProcess.Names

'       Remove sheet name part of the name
        sNameNoSheet = Right(nmLoop.Name, Len(nmLoop.Name) - InStr(nmLoop, "!") + 1)

        If sNameNoSheet = psRangeName _
         Then

            RangeNameExistsInSheet = True

            Exit Function

        End If

    Next nmLoop

End Function


Function IsValidCellAddress(psAddress As String)
   
    Dim sAddressTest As String
   
    IsValidCellAddress = False
   
    sAddressTest = ""
   
    On Error Resume Next
    sAddressTest = ActiveSheet.Range(psAddress).Address
    On Error GoTo 0
   
    If sAddressTest <> "" Then IsValidCellAddress = True

End Function


Function TableExistsInSheet(psTableName As String, pwsTarget) As Boolean

    Dim loLoop As ListObject

    Dim wsToProcess As Worksheet
   
    If IsMissing(pwsTarget) _
     Then
        Set wsToProcess = ActiveSheet
    Else
        If TypeName(pwsTarget) <> "Worksheet" _
         Then
            Set wsToProcess = ActiveSheet
        Else
            Set wsToProcess = pwsTarget
        End If
       
    End If
   
    TableExistsInSheet = False
   
    For Each loLoop In wsToProcess.ListObjects

        If psTableName = loLoop.Name _
         Then

            TableExistsInSheet = True

            Exit Function

        End If

    Next loLoop

End Function

 

[OaklandJim]

This version should accommodate tables with a varying number of columns. However, if the number of columns does increase that pushes the cell AN4 to the right so code does not know where to get the date. AS I said before, consider putting date in cell AE1 to address THAT issue.

New workbook is HERE.

Option Explicit
Option Base 1  '<= so arrays do not start at element zero.

' ----------------------------------------------------------------
' Procedure Name: TransferDataInWorksheets
' Purpose: Transfer data from range to table in specified sheets.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 4/13/2023
' Note: Transfers done are in the workbook containing this code (ThisWorkbook).
' ----------------------------------------------------------------

'This sub processes all sheets in which transfer of new data will occur.

Sub TransferDataInWorksheets()

    Dim wsToProcess As Worksheet
    
    Dim iSheetsToProcessCount As Long
    
    Dim iSheet As Long
    
'   Array containing 1. sheet name, 2. "data from" range name or cell address (in the sheet),
'   3. table name (in the sheet) for each sheet to be processed.
    Dim asSheetsData() As String
    
'   Count of sheets to process
    iSheetsToProcessCount = 2  '<= change to number of sheets to process.
    
'   Size the array to accommodate 3 data points for each sheet to process.
'   First array dimension is for 1. sheet name, 2. range name or address, 3. table name.
    ReDim asSheetsData(3, iSheetsToProcessCount)
    
'   For each sheet to process need entries in the array like the following two.
    
'   ~~~ Sheet 1 ~~~
    asSheetsData(1, 1) = "Source2"   '<= name of first sheet to process
    asSheetsData(2, 1) = "AF1"       '<= cell location of first (leftmost) new data value
    asSheetsData(3, 1) = "Table3"    '<= name of table to process in the first sheet to process
    
'   ~~~ Sheet 2 ~~~
    asSheetsData(1, 2) = "Source3"
    asSheetsData(2, 2) = "AF1"
    asSheetsData(3, 2) = "Table4"
    
    For iSheet = 1 To iSheetsToProcessCount
    
'       Check for sheet specified exists. If not tell user.
        If Not WorksheetExists(asSheetsData(1, iSheet)) _
         Then
            MsgBox "The worksheet named " & asSheetsData(1, iSheet) & " does not exist.", vbExclamation
            GoTo NextIteration
        End If
                        
        Set wsToProcess = ThisWorkbook.Worksheets(asSheetsData(1, iSheet))
                        
'       Check valid address or range name exists in the sheet being processed. If not tell user.
        If Not IsValidCellAddress(asSheetsData(2, iSheet)) _
        And Not RangeNameExistsInSheet(asSheetsData(2, iSheet), wsToProcess) _
         Then
            MsgBox "Range " & asSheetsData(2, iSheet) & " does not exist in sheet named " & wsToProcess.Name & ".", vbExclamation
    
'       Check table exists in the sheet being processed. If not tell user.
        ElseIf Not TableExistsInSheet(asSheetsData(3, iSheet), wsToProcess) _
         Then
            MsgBox "Table " & asSheetsData(3, iSheet) & " does not exist in sheet named " & wsToProcess.Name & ".", vbExclamation
    
'       Check for "new" data exists. If not tell user.
        ElseIf wsToProcess.Range(asSheetsData(2, iSheet)).Cells(1).Value = "" _
         Then
            MsgBox "No new data exists in the sheet named " & wsToProcess.Name & ".", vbExclamation
'
        Else
            
'           Range ID is valid, worksheet exists, table exists, there is new data...
    
'           ...so transfer new data to the table. Parameters are 1. the worksheet sheet
'           (object) to process, 2. range (object) where "new" data exists, and
'           3. the table (object) where "new" data is copied into.
    
            Call TransferDataToTable( _
                wsToProcess, _
                wsToProcess.Range(asSheetsData(2, iSheet)), _
                wsToProcess.ListObjects(asSheetsData(3, iSheet)))
        End If

NextIteration:
    
    Next iSheet

End Sub

Slightly different code to verify that a worksheet exists.

Function WorksheetExists(psSheetName As String, Optional pwbTarget As Variant) As Boolean

    Dim wsLoop As Worksheet

    Dim wbToProcess As Workbook
    
    If IsMissing(pwbTarget) _
     Then
        Set wbToProcess = ThisWorkbook
    Else
        If TypeName(pwbTarget) <> "Workbook" _
         Then
            Set wbToProcess = ThisWorkbook
        Else
            Set wbToProcess = pwbTarget
        End If
        
    End If
    
    WorksheetExists = False
    
    For Each wsLoop In wbToProcess.Worksheets

        If wsLoop.Name = psSheetName Then

            WorksheetExists = True

            Exit Function

        End If

    Next wsLoop

End Function