Sub Save_All_Files()
Call Account_Name_And_Year_1
Call Data_2021_1
Call Account_Name_And_Year_1
Call Data_2022_1
With Account_Name_And_Year_1
rootAccount = ws.Cells(103, 10).Value
year = ws.Cells(102, 11).Value
For Each pt In ws.PivotTables
With pt
With .PivotFields("Root Account")
.CurrentPage = rootAccount
End With
With .PivotFields("Year")
.CurrentPage = year
End With
End With
Next pt
End With
Call Data_2021_1
Call Data_2022_1
End Sub
I have a list of 3 Master with Account name in Column J row 101 to row 200+ and year in Column K row 101(2021) and row 102(2022). Macro Account_Name_And_Year changes pivot fields (Account name & year) in all Pivot tables in all 3 workbooks), Macro Data_2021_1 copies the data from all Pivot Tables from all 3 workbooks and paste it in template file(sheet1), then again Macro Account_Name_and_Year_1 changes pivot fields(this time only year to 2022 from "K102") and then Macro Data_2022_1 copies the data from all Pivot Tables from all 3 workbooks and paste it in template file(sheet2).
I was trying to do it for all accounts in one single click. Is it possible via calling macro and then editing it. Or is there any simpler way to save all 100+ files in single with with above conditions.
Related
I have a PivotTable that automatically refreshes every time I refresh a data set to our mySQL database in our office.
My Excel file launches a query against the mySQL database and returns a data table, and I have two PivotTables on separate sheets that will automatically update every time that is done. My code for that is below:
Sub UpdatePivots()
' This sub is intended to update all pivot charts in the by switching to the appropriate
' worksheet, locating the appropriate pivot table, and updating them.
Dim ws As Worksheet
Dim PT As PivotTable
For Each ws In ActiveWorkbook.Worksheets '<~~ Loop all worksheets in workbook
For Each PT In ws.PivotTables '<~~ Loop all pivot tables in worksheet
PT.PivotCache.Refresh
Next PT
Next ws
End Sub
What I am looking to do calculate a YIELD for some of the fields in the Pivot Table. The table currently looks like this below:
As you can see, I added in the "YIELD" column automatically and simply did an:
=GETPIVOTDATA("Pass / Fail",$B$5,"Job ID","Job 1","Pass / Fail","Pass")/GETPIVOTDATA("Pass / Fail",$B$5,"Job ID","Job 1")
Ideally, what I would like to do is add to my UpdatePivots() macro to automatically calculate the yield (Pass / Grand Total) for each of the rows listed.
This table is subject to change in size - sometimes I am looking at only 3 jobs in a given month (like September so far), other times my boss wants me to run this report for an entire year where I can have an upwards of 100 jobs. So I would like to use some pseudo code that might look like this:
Cell F6.Text = YIELD
<Apply Pivot Table Formatting to Cell F6>
for each row in pivottable {
Cell Fx.Value = Pass / Grand Total
}
Can anybody help me do that? I have tried brainstorming on paper, but don't even know where to start.
PS - How can I get the Pivot Table to stop that terrible formatting, and to keep my grayed cells? I want to eventually add in charts.
Thank you!!
The following code satisfies my need:
Sub CalculateYield()
k = Cells(Rows.Count, 2).End(xlUp).Row
For r = 9 To k
Cells(r, 6).Formula = "=" & Cells(r, 3).Address(False, False) & "/" & Cells(r, 5).Address(False, False)
Next
End Sub
I have two sheets in an Excel file and need to perform a COUNTIF formula from one sheet and paste the respective information in another sheet. The original sheet just has the type in 1st column with an empty 2nd column. I am trying to loop through the Type from Sheet 1, in each increment loop through the Type from Sheet 2, and past the Count of column 2 from Sheet 2 into Column 2 of sheet 1.
My current VBA code is as follows:
Sub TestOE()
'For loop to go until end of filled cells in 1st column of each sheet
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
'Loop
For i = 2 To a
For j = 2 To b
If Worksheets("Sheet1").Cells(i, 1).Value = Worksheets("Sheet2").Cells(j, 1).Value Then
Worksheets("Sheet1").Cells(i, 2).Value = Application.WorksheetFunction.CountIf(Range("B:B"), 1)
End If
Next j
Next i
End Sub
This code is only pasting 0's in the desired outcome on Sheet 1.
Sheet to extract information from
Sheet to paste information in
Desired Outcome in destination sheet
You can simply use sumif function to sum the values based on criteria.
here is the formula
=COUNTIF(Sheet1!$A$2:$A$20,Sheet2!A2)
if you want to sum the col B then
=SUMIF(Sheet1!$A$2:$A$20,Sheet2!A2,Sheet1!$B$2:$B$20)
In a few steps, you can accomplish what you want without VBA, and just use a pivot table. Just do as follows.
Select your data set, including the header.
Click on insert tab, then PivotTable. See example for Office 365
Since you want a different worksheet, set PivotTable to be "New Worksheet" See example.
You'll need to drag the TYPE field into the rows, and binary into the values. CountIF is the same as summing binary, so you can leave as sum. See Example
And you'll have an output nearly identical to what you're looking for:
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste
I have different workbooks with different sheets with same Sheet name.(Book1,Book2,Book3,excel1,excel2,micorsoft etc) in a folder.
I would like to create way to have the entire row (when data is entered) transfered to a summary workbook with the matching value in a cell.please see the example table below.
If you notice the example below,I have a Book1 with worksheet1 (it also have different worksheets along with this one).
Now my requirement is to copy entire row with matching status column cell or cells (eg: NEW,research) into the workbook where macro is running,from all the workbooks in a folder.
I request if some one can help me with this macro that will be great.
Note:
Not always but Some times this data would change from time to time, so it would have to keep over-writing with the most up to date data. I would just like it all to consolidate onto 1 workbook so I can have the data from there.
Is this something that can be done easily? I've tried my luck at some macros but I can't seem to get it.
Book1
Worrksheet1
column A column B column C status comment column D
Update
New
Modified
New
New
Research
Research
I was lucky enough to get a code to copy from one sheet to other in a single book the code is below
Code:
Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("New,research", ",")
For Each cell In Sheets("Worrksheet1").Range("E:E")
If (Len(cell.Value) = 0) Then Exit For
For i = 0 To UBound(aTokens)
If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Worrksheet1").Rows(cell.Row).Copy Sheets("final").Rows(iMatches)
End If
Next
Next
End Sub
Description:
This code will copy ALL rows content with the words matching NEW,research or any required in the column E : E from Worrksheet1 sheet to final sheet
Now change required in this is to copy from different workbooks in a folder(given path to directory) into single workbook in same or differ folder.
If i can have an option to email the copy like mentioned below link
will be great
Creating a Windows application which reads and writes excel spreadsheets + reads and writes emails
I'm not entirely sure I understand what you're after...But.
Open all the workbooks that you want copied.
Paste the following code into a standard module in one of the workbooks (it doesn't matter which one) Run it.
The code creates a new workbook and looks at every cell in row 1 of every workbook in every worksheet. (apart from the one that's just been created)
If it isn't blank it copies the entire column into the new workbook in the same worksheet number and in the same column position. Cheers.
Sub alltoone()
Application.ScreenUpdating = False
j = 0
ght = 0
Set nwrk = Workbooks.Add
For i = 1 To Workbooks.Count - 1
ght = Application.WorksheetFunction.Max(ght, Workbooks(i).Worksheets.Count)
Next i
If ght > nwrk.Worksheets.Count Then
Do
nwrk.Worksheets.Add
Loop Until ght = nwrk.Worksheets.Count
End If
For i = 1 To Workbooks.Count - 1
For k = 1 To Workbooks(i).Worksheets.Count
For t = 1 To 256
Set fez = Workbooks(i).Worksheets(k).Cells(1, t)
If Not fez.Value = Empty Then
fez.EntireColumn.Copy
nwrk.Worksheets(k).Columns(t).EntireColumn.PasteSpecial
End If
Next t
Next k
Next i
Set nwrk = Nothing
Set fez = Nothing
Application.ScreenUpdating = True
End Sub
I have data of this form:
Category Source Amount
Dues FTW $100
Donations ODP $20
Donations IOI $33
Dues MMK $124
There is no sort order. The categories are unknown at compile time. I want a VBA macro to cycle through the range, output a list of distinct values, with the subtotals for each. For the above data, it would look like this:
Category Total Amount
Dues $224
Donations $55
How can I do this? Also, is there a way to make the macro run every time the table above is updated, or is it necessary for the user to click a button?
You may want to use a built in Excel feature to do this. Looping can take a long time and be problematic if you have a lot of values to loop through.
Something like the following might get you started on creating a pivot table (from http://www.ozgrid.com/News/pivot-tables.htm)
Sub MakeTable()
Dim Pt As PivotTable
Dim strField As String
'Pass heading to a String variable
strField = Selection.Cells(1, 1).Text
'Name the list range
Range(Selection, Selection.End(xlDown)).Name = "Items"
'Create the Pivot Table based off our named list range.
'TableDestination:="" will force it onto a new sheet
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="=Items").CreatePivotTable TableDestination:="", _
TableName:="ItemList"
'Set a Pivot Table variable to our new Pivot Table
Set Pt = ActiveSheet.PivotTables("ItemList")
'Place the Pivot Table to Start from A3 on the new sheet
ActiveSheet.PivotTableWizard TableDestination:=Cells(3, 1)
'Move the list heading to the Row Field
Pt.AddFields RowFields:=strField
'Move the list heading to the Data Field
Pt.PivotFields(strField).Orientation = xlDataField
End Sub
This is for subtotals (though I much prefer pivot tables)
http://msdn.microsoft.com/en-us/library/aa213577(office.11).aspx
EDIT:
I reread and have the following thoughts. Set up the pivot table on a separate sheet (without using any code) then put the following code on the sheet that has the pivot table so that the table will update everytime the sheet is selected.
Private Sub Worksheet_Activate()
Dim pt As PivotTable
'change "MiPivot" to the name of your pivot table
Set pt = ActiveSheet.PivotTables("MyPivot")
pt.RefreshTable
End Sub
Edit #2
Refresh all pivot tables on sheet
http://www.ozgrid.com/VBA/pivot-table-refresh.htm
Private Sub Worksheet_Activate()
Dim pt As PivotTable
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Next pt
End Sub
The link has multiple options on how to refresh pivot tables in the sheet/workbook.