Joe Reichsfeld
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER