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 rTableRange As Range
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
' Variable that holds the last date in the table
Dim dLastDateInTable As Date
' 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)
' Count of data rows in the table.
Dim iTableRows As Long
Dim sMsg As String
' 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
GoTo NextIteration
End If
' 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
GoTo NextIteration
End If
' Check for "new" data exists. If not tell user.
If wsToProcess.Range(asSheetsData(2, iSheet)).Cells(1).Value = "" _
Then
MsgBox "No new data exists in the sheet named " & wsToProcess.Name & ".", vbExclamation
GoTo NextIteration
End If
' Point table object to thedata table
Set rTableRange = wsToProcess.ListObjects(asSheetsData(3, iSheet)).Range
' Get count of rows in the table before adding new data.
iTableRows = rTableRange.Rows.Count
' Grab the last date in the table.
dLastDateInTable = rTableRange.Cells(1).Offset(iTableRows - 1)
' Check month for the last date in data = today's date. If so skip to
' the next iteration/worksheet to proess.
If Month(dLastDateInTable) = Month(Now()) _
Then
sMsg = "Today's month and the month for the" _
& Chr(10) _
& "last date in the table are the same" _
& Chr(10) _
& "in the worksheet named " & wsToProcess.Name & "."
MsgBox sMsg, vbExclamation
GoTo NextIteration
End If
' Range ID is valid, worksheet exists, table exists,
' there is new data and today's month <> last data month...
' ...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)))
NextIteration:
Next iSheet
End Sub
