cierrasmadre

New Member
Joined
Jun 14, 2017
Messages
9
Keep in mind I'm self taught so please excuse any ignorance of mine. Background: Daily, I receive a report that consists of 20-25 text files, 1 for each state we have business in. I have a process that consists of a few different scripts run one after the other. It does a lot to the files with an end result of 1 workbook with 3 tabs showing specific segments of the information along with 3 tabs for pivot tables for each segment of data, followed by 20-25 tabs for breaking out some remaining data per state. My process does quite a bit and I'm aware it's DEFINITELY not the cleanest way, but it works and usually takes a minute vs 45 minutes or more manually.

Until today that is. I know where the issue is in my script and I know how to fix it, but not HOW to fix it. I'm hoping someone can help me in updating this code.

This part of my process pulls a 2nd pivot table from my main set of data (tab labeled as "All Records") to it's own tab, then copies the table and pastes it onto my main stats tab, labeled as "Stats - All Records". I do this because I couldn't figure out how to get it to create directly on my main stats tab. It then looks for 2 sets of data on this 2nd pivot table and pulls the raw data (manually we would double click the total next to the data to create a new tab of the raw data). Then renames each of the 2 new tabs accordingly and move them to the order I need in the workbook.

The problem is that today's report does not include any records for the 2nd set of data (labeled as Hold Days 10). So I need the script to say If not found, then End and continue on with the process. I'm attaching this entire script, but it's the last section I'm having issues with (unless someone knows how to clean the entire thing up ;)). After it runs this one, the process moves on to run my next script.

Code:
Sub I_InsertPivotTable2()
 
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
 
'Insert a New Blank Worksheet
On Error Resume Next
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Stats - Error Message"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Stats - Error Message")
Set DSheet = Worksheets("All Records")
 
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
 
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="StatsPivotTable")
 
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="StatsPivotTable")
 
'Insert Row Fields
With ActiveSheet.PivotTables("StatsPivotTable").PivotFields("Error Message")
.Orientation = xlRowField
.Position = 1
End With
 
'Insert Data Field
ActiveSheet.PivotTables("StatsPivotTable").AddDataField ActiveSheet.PivotTables _
        ("StatsPivotTable").PivotFields("KEY"), "Count of Key", xlSum
    With ActiveSheet.PivotTables("StatsPivotTable").PivotFields("Count of Key")
        .Caption = "Count of Key"
        .Function = xlCount
    End With
 
'Format Pivot Table
ActiveSheet.PivotTables("StatsPivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("StatsPivotTable").TableStyle2 = "PivotStyleMedium9"
 
Columns("B:C").Select
Selection.Copy
 
Sheets("Stats - All Records").Activate
Columns("H:I").Select
    ActiveSheet.Paste
 
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Stats - Error Message").Delete
Application.DisplayAlerts = True
 
' Locate records on Stats tab containing Record Missing and create a new tab with the raw data
    Worksheets("Stats - All Records").Activate
    Cells.Find(What:="RECORD MISSING", after:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Select
    Selection.ShowDetail = True
    ActiveSheet.Name = "Demo Master Missing"
    Worksheets("Demo Master Missing").Move _
       after:=Worksheets("All Records")
   
' Locate records on Stats tab containing Hold Days 10 and create a new tab with the raw data
    Worksheets("Stats - All Records").Activate
    Cells.Find(What:="Hold Days 10", after:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Select
    Selection.ShowDetail = True
    ActiveSheet.Name = "Hold Days 10"
    Worksheets("Hold Days 10").Move _
       after:=Worksheets("Demo Master Missing")
 
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
On Error Resume Next at the top of the script to turn error detection back off and On Error GoTo 0 at the end to turn error detection back on. Does that work?
 
Upvote 0
Yes and no. If I add in the On Error Resume Next and another line to add in a blank sheet if no error. It seems to be working great now. However, I pulled up old reports and tried it from data that does contain the Hold Days 10 error and ran into a problem where it still adds in a blank sheet, but renames the blank sheet instead of the tab with the actual Hold Days 10 errors on it. I'm missing something and I'm sure it's in my ignorance. Here's how I updated the last section of the script.

Code:
' Locate records on Stats tab containing Hold Days 10 and create a new tab with the raw data
    Worksheets("Stats - All Records").Activate
    Cells.Find(What:="Hold Days 10", after:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Select
    Selection.ShowDetail = True
    On Error Resume Next
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "Hold Days 10"
    On Error GoTo 0
    Worksheets("Hold Days 10").Move _
       after:=Worksheets("Demo Master Missing")


End Sub
 
Upvote 0
You have a great code-set right now and I don't look to ask you to re-invent the wheel. Without taking too much rework, I'd think you could simply create new sheets, set each new sheet as an appropriately named variable, and move data accordingly.
 
Last edited:
Upvote 0
If I'm understanding your response, that is what this is doing right now. On perfect days, it finds the "Hold Days 10" field on my pivot table and creates a new spreadsheet with the raw data. That becomes the active sheet and it renames it and moves it accordingly. The problem is that when it goes to my pivot table to find the "Hold Days 10", if there are none it's NOT creating a new spreadsheet. So it then renames the tab my pivot table is on since remains the active spreadsheet and moves it and so on per the script.

The change I made in the code above, will make it so that if there are None of the errors it's looking for, then it creates a new spreadsheet and renames/moves accordingly. But then it's the opposite issue so that if I do have this data, it pulls the raw data, but also inserts a new blank sheet and that's what is renamed/moved. I know that once I get it fixed fully, I'll probably smack myself for not getting it sooner.
 
Upvote 0

Forum statistics

Threads
1,214,905
Messages
6,122,174
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top