Define new table range

[sspatriots]

I have a code below that I've been tinkering with to create a new table for the next fiscal year. The only issue I'm having so far is that I want the table range to go down 1,500 rows versus. The size that this code creates is only for one row. Not sure how to get there. Currently, this code finds the last used cell in row one and then offsets to the right of that cell two cells to create this single column table of just only one row.

Sub CreateNewFiscalYearTable()
Dim ws As Worksheet
Dim lastCol As Long
Dim myRange As Range

Dim sThisFinancialYear As String
sThisFinancialYear = "tblPO" & IIf(Month(Date) <= 9, Year(Date) + 1, Year(Date) + 1) & "List"  'REMOVE THE " +1 " AFTER "Year(Date)" FROM THIS LINE LATER AFTER TESTING, SPS, 01/10/24

Set ws = Worksheets("Drops")
Set myRange = CELLS(1, Columns.Count).End(xlToLeft).Offset(0, 2)

MsgBox myRange.Address

myRange.Select

Dim tb As Range
Dim wsht As Worksheet
Set tb = myRange
Set wsht = ActiveSheet
ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=tb).Name = sThisFinancialYear    '"tblPO" & sThisFinancialYear & "List"



End Sub

 

[Jeffrey Mahoney]

Please try this:

Sub CreateNewFiscalYearTable()
  Dim ws As Worksheet
  Dim lastCol As Long
  Dim myRange As Range
  Dim sThisFinancialYear As String
  
  sThisFinancialYear = "tblPO" & IIf(Month(Date) <= 9, Year(Date) + 1, Year(Date) + 1) & "List"  'REMOVE THE " +1 " AFTER "Year(Date)" FROM THIS LINE LATER AFTER TESTING, SPS, 01/10/24
  
  Set ws = Worksheets("Drops")
  With ws
  Set myRange = .Range(.Cells(1, 1), .Cells(1, Columns.Count).End(xlToLeft).Offset(1500, 2))
  End with
  
  MsgBox myRange.Address
  
  myRange.Select
  
  Dim tb As Range
  Dim wsht As Worksheet
  Set tb = myRange
  Set wsht = ActiveSheet
  ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=tb).Name = sThisFinancialYear    '"tblPO" & sThisFinancialYear & "List"



End Sub

 

[sspatriots]

Perfect. Thank you. Worked like a charm.