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

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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

S
  • Question
VBA Pivot Table
Replies
3
Views
1K
Domenic
D
B
  • Question
All PivotItems Listing as Hidden or Not Visible
2
Replies
13
Views
693
RoryA
RoryA
Cubist
  • Solved
VBA - Need help optimize code that's updating pivot tables.
Replies
1
Views
114
Cubist
Cubist
M
  • Question
faster vba code for creating a pivot
Replies
5
Views
810
Monicasinha
M
C
  • Question
Pivot Table from Power Query - reorder Columns (Excel 2021)
Replies
4
Views
326
craigcurtin
C

Forum statistics

Threads
1,216,089
Messages
6,128,750
Members
449,466
Latest member
Peter Juhnke

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