mjlh
07-01-2019, 08:01 PM
Hi all,
I've currently got a marco (HRImportsSTaRData) that helps me to pull data from other worksheets into the existing sheet, and then turn it into a named Table ("Data") which is linked to a pivot table and a related formula (Cell R1) in the "Codes" worksheet. However, because the code only turns the range into a Table at the end, I'm unable to automatically link another macro linking to the pivot table and formula.
I want to maintain the link of the pivot table and R1 to the named table in the Data worksheet, but am unsure of how to my current macro to allow it to insert rows into the existing named table instead of range. I've attached the sample files in the attached.
Option Explicit
Sub ImportSTaRData()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet
Dim LastRowUsed As Long
Dim destrange As Range
'***** Set folder to cycle through *****
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) 'Dialogue to select folder wtih files
.AllowMultiSelect = False
.Show
On Error Resume Next
Path = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = ActiveWorkbook 'select workbook variable as open file
mWB.Sheets("Data").Select 'select worksheet to copy data into
Set aWS = mWB.ActiveSheet 'set active sheet variable to data sheet
LastRowUsed = aWS.Cells(aWS.Rows.Count, "C").End(xlUp).Row
If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
Path = Path & Application.PathSeparator 'add "\"
FileName = dir(Path & "*.xl*", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
Set tWS = tWB.Sheets("STaR Data 2019")
Set uRange = tWS.Range("C3:BE50") 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(after:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
' If RowCount = 0 Then 'if working with a new sheet
' aWS.Range("D100", "CL100").Value = _
' tWS.Range("D100", "CL100").Value 'copy headers from tWS
' RowCount = 1 'add one to rowcount
' End If
Set destrange = aWS.Range("C" & RowCount + LastRowUsed + 2)
uRange.Copy
With destrange
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'aWS.Range("C" & RowCount + LastRowUsed + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
'aWS.Range("CW" & RowCount + 1).Resize(uRange.Rows.Count, 1).Value _
'= FileName
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
tWB.Close False 'close temporary workbook without saving
End If
FileName = dir() 'set next file's name to FileName variable
Loop
mWB.Sheets("Data").Select 'select fourth data sheet on master workbook
'aWS.Protect ("9a9b9c")
Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on
mWB.Sheets("Data").Range("C2:BE200").AutoFilter field:=1, Criteria1:=""
Application.DisplayAlerts = False
mWB.Sheets("Data").Range("C3:BE200").SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
On Error Resume Next
mWB.Sheets("Data").ShowAllData
On Error GoTo 0
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$C2:BE50"), , xlYes).Name = _
"Data"
ActiveSheet.ListObjects("Data").TableStyle = "TableStyleLight15"
ActiveSheet.ListObjects("Data").ShowTableStyleRowStripes = False
'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End If
End Sub
I've currently got a marco (HRImportsSTaRData) that helps me to pull data from other worksheets into the existing sheet, and then turn it into a named Table ("Data") which is linked to a pivot table and a related formula (Cell R1) in the "Codes" worksheet. However, because the code only turns the range into a Table at the end, I'm unable to automatically link another macro linking to the pivot table and formula.
I want to maintain the link of the pivot table and R1 to the named table in the Data worksheet, but am unsure of how to my current macro to allow it to insert rows into the existing named table instead of range. I've attached the sample files in the attached.
Option Explicit
Sub ImportSTaRData()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet
Dim LastRowUsed As Long
Dim destrange As Range
'***** Set folder to cycle through *****
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) 'Dialogue to select folder wtih files
.AllowMultiSelect = False
.Show
On Error Resume Next
Path = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = ActiveWorkbook 'select workbook variable as open file
mWB.Sheets("Data").Select 'select worksheet to copy data into
Set aWS = mWB.ActiveSheet 'set active sheet variable to data sheet
LastRowUsed = aWS.Cells(aWS.Rows.Count, "C").End(xlUp).Row
If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
Path = Path & Application.PathSeparator 'add "\"
FileName = dir(Path & "*.xl*", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
Set tWS = tWB.Sheets("STaR Data 2019")
Set uRange = tWS.Range("C3:BE50") 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(after:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
' If RowCount = 0 Then 'if working with a new sheet
' aWS.Range("D100", "CL100").Value = _
' tWS.Range("D100", "CL100").Value 'copy headers from tWS
' RowCount = 1 'add one to rowcount
' End If
Set destrange = aWS.Range("C" & RowCount + LastRowUsed + 2)
uRange.Copy
With destrange
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'aWS.Range("C" & RowCount + LastRowUsed + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
'aWS.Range("CW" & RowCount + 1).Resize(uRange.Rows.Count, 1).Value _
'= FileName
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
tWB.Close False 'close temporary workbook without saving
End If
FileName = dir() 'set next file's name to FileName variable
Loop
mWB.Sheets("Data").Select 'select fourth data sheet on master workbook
'aWS.Protect ("9a9b9c")
Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on
mWB.Sheets("Data").Range("C2:BE200").AutoFilter field:=1, Criteria1:=""
Application.DisplayAlerts = False
mWB.Sheets("Data").Range("C3:BE200").SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
On Error Resume Next
mWB.Sheets("Data").ShowAllData
On Error GoTo 0
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$C2:BE50"), , xlYes).Name = _
"Data"
ActiveSheet.ListObjects("Data").TableStyle = "TableStyleLight15"
ActiveSheet.ListObjects("Data").ShowTableStyleRowStripes = False
'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End If
End Sub