Link to home
Start Free TrialLog in
Avatar of Joe Reichsfeld
Joe ReichsfeldFlag for United States of America

asked on

Declaring dynamic table and naming it .

I set up am excel macro to pull in a spreadsheet of line item PO's and then it formats for our shipping system.   Im able to pull in the worksheet, name ranges etc.   The problem Im having is naming the table and establishing ti so it expands and contracts depending on the amount of po's that day6.  Ive tried several different methods and at this point think ive really made a mess of the code



The table needs to be named POTable and as I said if the code is messy, its because Ive been beating this up for days.  I was having issues with the table not expanding so I had to give it a specific named amount of rows but I need it to be dynamic as that fluctuates.  Thanks for your help

Sub PullPOs()
'Declare Variables
Dim PSheet As Worksheet
Dim PCache As PivotCache
Dim POTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
    
'Delete Preivous PivoTable Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PurchaseOrders").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PurchaseOrders"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PurchaseOrders")
    RowofCopySheet = 1 ' Row Number from where you wish to start copying
    
    'path = SelectFolder("Select a folder containing Excel files you want to merge")
    path = ("c:\orders\")
  ' set the starting column for the data, in this case 1
    ' change if the data does not start in column A
    Const Colno = 1
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & "PurchaseOrders")
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("a" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
       Filename = Dir()
    Loop

Cells.Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("H:O").Select
    Selection.Cut
    Range("AL1").Select
    Selection.Insert Shift:=xlToRight


'Define Data Range
LastRow = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = PSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = PSheet.Cells(1, 1).Resize(LastRow, LastCol)

'Define Cache
Set PCache = ActiveWorkbook.TableCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreateTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="POTable")
 ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BF$100"), , xlYes).Name = _
        "POTable"
    Range("POTable[#All]").Select
    ActiveSheet.ListObjects("POTable").TableStyle = "TableStyleLight1"
'Insert Blank Pivot Table
Set PTable = ActiveWorkbook.CreateTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="POTable")

   Range("A1").Select
ActiveSheet.UsedRange

    Dim rCell2 As Range
    Dim wb2 As Workbook, ws2 As Worksheet
   
ActiveSheet.UsedRange.Select
    Set ws2 = Selection.Parent
    Set wb2 = ws2.Parent
   
    For Each rCell2 In Selection.Cells
    
    If rCell2.Address = "$A$2" Then Exit For
        
        wb2.Names.Add rCell2.Value, "=" & ws2.Cells(2, rCell2.Column).Address & _
            ":INDEX(" & rCell2.EntireColumn.Address & _
            ",COUNTA(" & rCell2.EntireColumn.Address & "))"
       
    Next rCell2
   

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Joe Reichsfeld

ASKER

Thanks Rob.  I knew there was a much easier solution.