Defining variable Source range for pivot chart code in VBA - vba

I have recorded a macro for pivot table and chart. Now I what to change the range as per the changes in the rows and columns of the source sheet.
The code from the recorded macro is:
SourceData:= _
"DATA INPUT SHEET!R2C1:R23C12", Version:=xlPivotTableVersion15)
Any way out to change the Range R2C1:R23C12 to Range(Cells(2,1),Cells(FinalRow,8+NoBids)), where Finalrow is the last row of the source sheet and NoBids is to the no. of columns to be added after the 8th column of the source sheet.

There is a way, try the code below:
SourceData:= "DATA INPUT SHEET!" & Range(Cells(2, 1), Cells(FinalRow, 8 + NoBids)).Address(True, True, xlR1C1)
If you want to learn more about the Range.Address Property, read HERE

Related

Excel VB Advanced Filter Copy with Condition

I am trying to put a condition on each row copied. I want all uniques but only if they also have a specific value in another field.
This is what I have to grab all uniques (and it works) but I can't figure out how to get only the rows with a specific value in column J.
r1.Columns(20).AdvancedFilter xlFilterCopy, , Sheet11.Range("A1"), unique:=True
I have tried doing a CriteriaRange but I can't seem to get the syntax correct for it. Additionally I thought about an If statement but logically in my head it means it would fire off the whole list every time it has a true statement, not on a per row basis.
Here is how I thought it might work. But I get a type mismatch error.
r1.Columns(20).AdvancedFilter xlFilterCopy, r1.Columns(10).Value = "November", Sheet11.Range("A1"), unique:=True
Thoughts?
First of all, your Criteria Range should be just that - a Range with the header corresponding to the column to be filtered, and criteria underneath. For example, D1:D2 in this snapshot:
Secondly, you won't be able to copy just a single column (20) while filtering another column (10) in the same step.
You can tweak the Advanced Filter to
First filter the entire list in place based on the criterion provided
And then copy the visible cells in the column in question
Something like this (change Sheet and Range references as needed):
Sub MyFilter()
Dim lastRow As Long
With Sheet1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:B" & lastRow).AdvancedFilter _
Action:=xlFilterInPlace, CriteriaRange:=.Range("D1:D2"), Unique:=True
With .Range("B1:B" & lastRow).SpecialCells(xlCellTypeVisible)
.Copy Sheet2.Range("A1")
End With
.ShowAllData
End With
End Sub
To be able to keep the other parts of the code that worked perfectly. I added a hidden sheet and wrote a macro to copy the filtered results out to the new hidden sheet. Then I ran my original code against the filtered data on that hidden sheet.
Sub FilterLiveToDataSheet()
' Unhide Required Sheets
Sheets("Original-Data").Visible = True
Sheets("Filtered-Data").Visible = True
' Delete Old Data
Sheets("Filtered-Data").Select
Cells.Select
Selection.ClearContents
' Copy Filtered Data
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("TBL_ATTR_Spend").Range.AutoFilter Field:=10, _
Criteria1:="Delta"
Cells.Select
Selection.Copy
' Paste to Data Sheet
Sheets("Filtered-Data").Select
Cells.Select
ActiveSheet.Paste
' Unfilter Original Data Page
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
' Hide Required Sheets
Sheets("Original-Data").Visible = False
Sheets("Filtered-Data").Visible = False
' Go to Results Sheet
Sheets("Results").Select

Extract years, months and days from columns to create an excel formatted date column

I basically want to extract the years, the months and the days from the corresponding columns and use them to create an excel formatted date column with VBA.
With screenshots, it should at first look like this:
Excel Spreadsheet with Year Column and Date Column.
Whereas, ultimately, the year column should be removed with only the date column remaining (leaving aside the description) and containing the excel formatted dates. Excel Spreadsheet with Date Column only
Now, there might be an easier way to accomplish this task but the method I've undertaken is to:
Insert two new columns to the right of the Date column
Select the Date column and move over the months to the newly created column on the right by using the Text to Columns function
Format the blank 2nd newly created column to the Date category
Insert the date function into the cells of this blank column and autofill it to the cells below. More precisely, this date function is: =DATE(A2,MONTH(1&C2),B2)
Copy this New Date Column and paste it back as values only for later purposes of sorting.
Delete all other useless columns (year,month,day)
Though this is feasible with the excel interface, I'd like to accomplish this task with VBA and so I've already written quite a bit of code. Unfortunately, being a novice in VBA, I'm currently stuck at applying the formula at the final date column.
Before you take a look at my code, I'd also like to point out that I prompt the user to select the Description column as a reference column as it isn't always the case that the the year column is the first column or that the date column is the 2nd one. What is absolutely certain, however, is that to the left of the Description column, there is, respectively, the date and the year column.
Finally, if someone would also ameliorate my VBA code by solely allowing the formula to be applied to the first and last rows containing years or dates (same thing), I'd appreciate it.
I thank you all in advance.
Here below is my code
Sub Macro1()
'Set variables
Dim DescRng As Range
Dim DayRng As Range
Dim MonthRng As Range
Dim YearRng As Range
Dim DateRng As Variant
'Obtain reference column with prompt
Set DescRng = Application.InputBox("Select Description Column", "Obtain Object Range", Type:=8)
'Create new columns from reference column
Columns(DescRng.Column).Insert Shift:=x1ToLeft
Columns(DescRng.Column).Insert Shift:=x1ToLeft
'Assign variables to columns
Set DateRng = DescRng.Offset(rowOffset:=0, columnOffset:=-1)
Set MonthRng = DescRng.Offset(rowOffset:=0, columnOffset:=-2)
Set DayRng = DescRng.Offset(rowOffset:=0, columnOffset:=-3)
Set YearRng = DescRng.Offset(rowOffset:=0, columnOffset:=-4)
'Seperate the days from the months with TextToColumns
Columns(DayRng.Column).TextToColumns Destination:=DayRng, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'Format the DateRng column for later sorting use
Columns(DateRng.Column).NumberFormat = "yyyy-mm-dd"
'Apply Formula to DateRng Column
'Copy Formula in DateRng and paste into the same column as values
Columns(DateRng.Column).Copy
Columns(DateRng.Column).PasteSpecial Paste:=xlPasteValues, SkipBlanks _
:=False, Transpose:=False
'Delete the other Columns (YearRng, MonthRng, DayRng)
YearRng.Delete
DayRng.Delete
MonthRng.Delete
End Sub
Edit: I'm grateful for the insight your answers have brought. You've made possible a simple task with a short code, unlike my unfinished one. Learned a lot from my first post. Thanks
Try creating a valid string date with the displayed values from columns A and B.
with worksheets("sheet1")
for i=2 to .cells(rows.count, 1).end(xlup).row
.cells(i, 1) = datevalue(.cells(i, 2).text & ", " & .cells(i, 1).text)
.cells(i, 1).numberformat = "yyyy-mm-dd"
next i
.columns(2).entirecolumn.delete
.cells(1, 1) = "date"
end with
I took a different approach than #Jeeped so I figured i'd share since I took the time to practice with your question anyway. You will just need to format Col A with desired date format.
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim DayMonth As Variant
ws.Columns("A:A").Insert: ws.Range("A1") = "Date"
For i = 2 To ws.Range("B" & ws.Rows.Count).End(xlUp).Row
DayMonth = Split(ws.Range("C" & i), Chr(32))
ws.Range("A" & i) = DateValue(DayMonth(0) & Chr(32) & Month(1 & DayMonth(0)) & Chr(32) & ws.Range("B" & i) & Chr(32))
Next i
ws.Columns("A:A").AutoFit
ws.Columns("B:C").Delete

Autofiltering Pivot and Non-pivot Columns using Excel VBA

I have a pivot table from column B to column N. On the left, in column A, there's some data for which I used the content in the pivot table to look up for some values. On the right, in column O to X, there's also some other data which are calculated based on the pivot table's content.
I need to filter column X = 1 and then column V = 0. Below are my codes:
Dim ws As Worksheet, LastCell As Long
Set ws= ThisWorkbook.Worksheets("Sheet1")
LastCell = ws.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("$A$4:$X$" & LastCell).AutoFilter Field:=24, Criteria1:="1"
ws.Range("$A$4:$X$" & LastCell).AutoFilter Field:=22, Criteria1:="0"
Problem is, I get "Run-time error '1004': AutoFilter method of Range class failed".
But the code that I get from recording the macro is not that far off either, I just added my own variables:
ActiveSheet.Range("$A$4:$X$900").AutoFilter Field:=24, Criteria1:="1"
ActiveSheet.Range("$A$4:$X$900").AutoFilter Field:=22, Criteria1:="0"
I tried to run back the recorded code afterwards, and I get the same error. What is causing this and how can I fix it?
Thanks in advance!
Welp, I got the answer after trying to explore some other ideas.
Instead of using:
ws.Range("A4:X" & LastCell).AutoFilter Field:=24, Criteria1:="1"
ws.Range("A4:X" & LastCell).AutoFilter Field:=22, Criteria1:="0"
I used:
ws.Range("A4").AutoFilter Field:=24, Criteria1:="1"
ws.Range("A4").AutoFilter Field:=22, Criteria1:="0"
I noticed this as I was trying to use autofilter manually on Excel. I highlighted the whole data and was unable to click the filter button. Normally, it doesn't matter whether you only select a cell or the whole sheet, but since I'm using autofilter on pivot table as well, the only way I was able to use it is by selecting any cell other than the pivot table's.

How to select data range dynamically for pivot table

I have searched this topic exhaustively however I am struggling to find a solution which works for my macro. I need the source data for a pivot table to include all rows (containing data) on a sheet. The amount of rows will change daily.
Here is what I've got so far:
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "RAW_DATA"
Range("A1").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"RAW_DATA!R1C1:R159C24", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet4!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet4").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Asset")
.Orientation = xlRowField
.Position = 1
End With
The values which represent my pivot tables source data are RAW_DATA!R1C1:R159C24. The problem is that I need this range to dynamically increase or decrease depending on the size of the populated source data range.
First of all, you might be able to easily solve your problem by just setting the columns as your datarange (E.g. RAW_DATA!$A:$X).
When the data is appended a simple update on the pivot will include new data or exclude the data that is no longer there.
That said, here's a VBA solution:
This Example will change the source data for PivotTable1 on Sheet1 to be "RAW_DATA!$A$1:$X$ whatever the last row is"
Sub ChangePivotData()
Dim lastrow as double
lastrow = Worksheets("RAW_DATA").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet1").PivotTables("PivotTable1")
.ChangePivotCache ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:="RAW_DATA!A2:X" & CStr(lastrow), _
Version:=xlPivotTableVersion14)
End With
End Sub
That is the core of it. However, you might want to check for blank column headers to do some error prevention, automatically refresh the table after the new cache has been set, etc.
More extensive example can be found here:
http://www.thespreadsheetguru.com/the-code-vault/2014/7/9/change-a-pivot-tables-data-source-range
Enjoy :)
You can use the below if your data is the only thing in the sheet
Worksheets("RAW_DATA").Usedrange
and the corresponding range address
Worksheets("RAW_DATA").Usedrange.Address
Hope this helps

Copying additional inputs to excel and filling automatically

I need to copy new data from a sheet every week to an already existing sheet having all the past data. The Existing sheet columns(some) are also formulated using Vba. I have written the code which copies the data in to the sheet but the other columns are not filled up(or dragged) automatically.
Sub Transfernewdata()
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet2")
lastrow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("D5:D" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 4)
Range("C5:C" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 3)
Range("B5:B" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 2)
Range("A5:A" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 1)
ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0) = Date
Application.CutCopyMode = False
End Sub
I just transfer 4 columns and rest are to be filled up automatically. I try to put the date(last line of code) but even that doesn't fill up more than once. Any help is appreciated, also I don't understand that every module I run does not affect the new data added.
change this:
ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0) = Date
to this:
ThisWorkbook.Worksheets("Sheet1").Range("A" & lastrow & ":a65536") = Date
Based on the additional information you provided in the comments, below, I would suggest making your data into a table. The formulas should automatically copy themselves every time you insert a row into the table.
If you move your cursor to the top left corner of your data set then press Ctrl-T it will automatically tabelize all the contiguous data you already have there. (You'll have to tick or untick the 'My data has headers' question, as appropriate.)