Save Workbook in Specific Folder once Marco Runs

S

sg2209

Board Regular
Joined
Oct 27, 2017
Messages
117
Office Version
  1. 2016
Hi ,

i have written a below code however got stuck in below last lines where i am trying to save the workbook in specific Folder
Save as and xlsb format with Name Updated BaseSheet and the Current Date .

and no need to run another macro when my First Macro Runs and after that it Should save auto in the folder i need , please help what changes should i ammend

Sub sbCreatePivot()


Dim ws As Worksheet
Dim pc As PivotCache
Dim Pt As PivotTable
Dim pt2 As PivotTable
Dim pt3 As PivotTable
Dim Wb As Workbook




'Vlook Up from Sheet Team Name


Dim lLastRow As Long

With Sheets("Data")
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("U2:U" & lLastRow)
.FormulaR1C1 = "=VLOOKUP(RC3,'Team Name'!C2:C3,2,FALSE)"
.Value = .Value
End With
End With


'Sorting the Column A
Range("A1:A5000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes


'Running Duplicate A1=A2


Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("A65000").End(xlUp).Row
For iCntr = 1 To lastRow
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 20) = "Duplicate"
End If
End If
Next


'adding new worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
'Set ws = Worksheets.Add
Application.DisplayAlerts = True
Set ws = Worksheets("PivotTable")


'Creating Pivot cache


Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Data!R1C1:R50000C21")


'creating pivottable


Set Pt = pc.CreatePivotTable(ws.Range("A8"))


'Fileds Setting


With Pt


'Row Fileds Setting


With .PivotFields("Last_Touch_User_Name")
.Orientation = xlRowField
.Position = 1
End With


'ReoprtFiler Fileds Setting


With .PivotFields("Action_Code")
.Orientation = xlPageField
.Position = 1
End With


With .PivotFields("Dup")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Dup")
.PivotItems("Duplicate").Visible = False
End With


With .PivotFields("Result_Code")
.Orientation = xlPageField
.Position = 1
End With

With .PivotFields("Team")
.Orientation = xlPageField
.Position = 1
End With

On Error Resume Next
With .PivotFields("Team")
.PivotItems("WB").Visible = False
.PivotItems("Web MD").Visible = False
.PivotItems("#N/A").Visible = False
.PivotItems("OTHERS").Visible = False
End With
On Error GoTo 0








With .PivotFields("Action_Code")
.PivotItems("RESEARCH").Visible = False
End With

With .PivotFields("Result_Code")
.PivotItems("ISSUE").Visible = False
End With


'Data Filed Setting
'.AddDataField .PivotFields("Medical_Manager__"), "Count of Medical_Manager", xlCount

With .PivotFields("Medical_Manager__")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
End With

With .PivotFields("Account_Balace_Acct_level")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
End With
End With




'====================================SECOND PIVOT=====================================================================================


Set Pt = pc.CreatePivotTable(ws.Range("E8"))
With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Last_Touch_User_Name")
.Orientation = xlRowField
.Position = 1
End With
End With


With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Action_Code")
.Orientation = xlPageField
.Position = 1
End With
End With


With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Result_Code")
.Orientation = xlPageField
.Position = 1
End With
End With


With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Dup")
.Orientation = xlPageField
.Position = 1
End With
End With
With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Dup")
.PivotItems("Duplicate").Visible = False
End With
End With


With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Team")
.Orientation = xlPageField
.Position = 1
End With
On Error Resume Next
With .PivotFields("Team")
.PivotItems("WB").Visible = False
.PivotItems("Web MD").Visible = False
.PivotItems("#N/A").Visible = False
.PivotItems("OTHERS").Visible = False
End With
On Error GoTo 0


ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Medical_Manager__"), "Count of Medical_Manager__", _
xlCount
With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Account_Balace_Acct_level")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
End With
End With




Range("E4").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Action_Code"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("Action_Code").CurrentPage _
= "RESEARCH"

ActiveSheet.PivotTables("PivotTable2").PivotFields("Result_Code").CurrentPage _
= "(ALL)"
On Error Resume Next
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Result_Code")
.PivotItems("ADJ").Visible = False
.PivotItems("AFU").Visible = False
.PivotItems("ASI").Visible = False
.PivotItems("BAD").Visible = False
.PivotItems("CIP").Visible = False
.PivotItems("CLS").Visible = False
.PivotItems("CNS").Visible = False
.PivotItems("COMMENT").Visible = False
.PivotItems("HLD").Visible = False
.PivotItems("HS2").Visible = False
.PivotItems("HS3").Visible = False
.PivotItems("HS4").Visible = False
.PivotItems("HS8").Visible = False
.PivotItems("INS").Visible = False
.PivotItems("INSREV").Visible = False
.PivotItems("INSWAIT").Visible = False
.PivotItems("LTR1").Visible = False
.PivotItems("PIF").Visible = False
.PivotItems("PNDHC").Visible = False
.PivotItems("PPLN").Visible = False
.PivotItems("RFN2").Visible = False
.PivotItems("RSL").Visible = False
.PivotItems("TBP").Visible = False
.PivotItems("VOD ").Visible = False
.PivotItems("WO").Visible = False
.PivotItems("AAK").Visible = False
.PivotItems("FINAS").Visible = False
.PivotItems("RSLB").Visible = False
End With
On Error GoTo 0
ActiveSheet.PivotTables("PivotTable2").PivotFields("Result_Code"). _
EnableMultiplePageItems = True
End With




'====================================SECOND PIVOT=====================================================================================


Set Pt = pc.CreatePivotTable(ws.Range("I8"))
With ActiveSheet.PivotTables("PivotTable3")
With .PivotFields("Team")
.Orientation = xlRowField
.Position = 1
End With
End With


ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Medical_Manager__"), "Count of Medical_Manager__", _
xlCount


With ActiveSheet.PivotTables("PivotTable3")
With .PivotFields("Dup")
.Orientation = xlPageField
.Position = 1
End With
End With
With ActiveSheet.PivotTables("PivotTable3")
With .PivotFields("Dup")
.PivotItems("Duplicate").Visible = False
End With
End With
ActiveWorkbook.ShowPivotTableFieldList = False


ActiveWindow.Zoom = 82


ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
"E:\DJO" & Activesheet.Name & format(Date, "MMYY") & ".xls",


End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Try
Code: 
ActiveWorkbook.SaveAs _
"E:\DJO\" & ActiveSheet.Name & Format(Date, "MMYY"), 50
 
Upvote 0
glad to help & thanks for the feedback
 
Upvote 0
in the mid of the code
'Running Duplicate A1=A2


Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("A65000").End(xlUp).Row
For iCntr = 1 To lastRow
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 20) = "Duplicate"
End If
End If
Next

i am getting the word Duplicate where that value in Column A is more than once , what changes i need to make to get Original where the Value in A Column is Single , please review the above Code.
 
Upvote 0
How about
Code: 
If iCntr <> matchFoundIndex Then
Cells(iCntr, 20) = "Duplicate"
Else
Cells(iCntr, 20) = "Original"
End If
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA Add Pivot Table Sheet Name
Replies
1
Views
176
Anthony47
A
C
  • Question Question
Pivot Table VBA
Replies
0
Views
230
chaddres
C
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
168
Jette3173
J
D
  • Question Question
VBA Coding for adding Pivot Table with changing data table
Replies
6
Views
193
darmst24
D
D
  • Question Question
VBA code to filter out blank values in a pivot table
Replies
2
Views
585
dragontbone
D

Forum statistics

Threads
1,223,909
Messages
6,175,310
Members
452,634
Latest member
cpostell

Share this page

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