sort and subtotal preselected data - vba

I'm working with a worksheet and at some point within there is a list of costs. However this list changes so can have varying numbers of rows. My ultimate goal is to sort and then subtotal this list of costs. Because the number of rows I want to sort and subtotal are always different, I was thinking I could make a macro that would only work off of preselected data eg the user to select the cells range to apply to be sorted and subtotalled. I can't just work off of all active cells, as there are some rows I don't want to include in the sort and subtotal.
I've recorded the following simple macro to sort and subtotal data, however, you'll note it only works for the cells that were selected when I recorded the macro. Does anybody know how to modify the macro so that the user can firstly manually select the cells range with the mouse and then click a button that automatically sorts the preselected data and subtotals it? any help very appreciated, thank you.
Sub Sort_and_Subtotal_CheckBox()
ActiveWorkbook.Worksheets("dummy").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("dummy").AutoFilter.Sort.SortFields.Add Key:=Range( _
"B151:B159"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("dummy").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B151:K156").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Try this code. This will allow the user to select the range by using an Input box.
Dim SortRng As Range
Set SortRng = Application.InputBox("Select the range to sort", "Select Range", 0, , , , , 8)
SortRng.Select
Selection.Sort Key1:=SortRng, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

If you would like to obtain the selected range, you could simply request Selection.Address in VBA. However, I believe that this assumes that the selection is a block of cells, so this might not always give the desired result (e.g. in case of multiple selected ranges). Another solution might be to convert the list of costs to a table. In your macro you can then simply refer to a named range, namely, the column in the newly created table. The table will work as a dynamic named range and will always include the entire range of values in it. If you can be sure that there will be no data below the list of costs, a second option would be to check the last row that is not empty within the column where the list of costs is stored. Something in the likes of .Cells(.Rows.Count, "A").End(xlUp).Row to get the last row of the column that contains the list.

Related

Having trouble getting column sort to work in VBA

Total disclosure - I am out of my depth here! I'm editing a macro a made with VBA editor and I need to get column W to sort by values highest to lowest. The "header" in column W starts at W8 and the first row of actual data is from W9 downwards. I do want to entire worksheet to resort just as it would have done had I used the filter arrow on the column header to o the same thing (presuming I had filter arrows on all the columns which I do). The thing is that this macro is to be run on an input template which gets updated once a month and every month new rows are added so I need to be able to make sure the sort gets applied from W9 to the last row of data (whatever that may be on that particular month).
I hardly dare post my awful attempt at the code - I just have something which I can confirm doesn't work!
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1345").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1345").Sort.SortFields. _
Add Key:=Range("Table1345[[#All],[Reporting_Period_Total]]"), SortOn:= _
xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1345").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
You can use Sort method of Range object. You can use up to 3 columns this way. In this example I assume the table's range is U8:W12:
Sub SortList()
Dim list As ListObject
Set list = Sheets("Sheet1").ListObjects("Table1345")
With list.Range
.Sort Key1:=.Cells(3), Order1:=xlAscending, Header:=xlYes '//Change order as needed
End With
End Sub

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

How to check the sign of a cell and then copy and paste it to another sheet?

I have a column of numbers and want to go through each cell to check if the number is positive, or negative. After determining if a number is positive, or negative I want to copy and paste that number into a new table on a new sheet separating the positive and negative values.
I used a nested if statement to do this originally but instead of getting a list of 20 positive numbers, and 20 negative numbers from my total of 40 numbers I got a list of 20 positive numbers with 20 false conditions in my new positive only table (same thing with the negative).
I would like to pull the positive and negative values without duplicating them, or getting the false condition of the if statement in my new table.
The last thing I have been trying to implement is having this code search through my column of numbers instead of a fixed range so in the future I can add numbers and the new positive/negative tables will automatically generate the additional numbers.
I am fairly new to VBA and coding in general so any help is much appreciated.
Thanks,
Olek!
My code pretty much follows the Macro code:
Sub Variance()
'
' Variance Macro
'
'
Range("F2:F60").Select
Selection.Copy
Sheets("Macro").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:A60").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.AutoFilter
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:=">=0", _
Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-12
Range("A3:A60").Select
Selection.Copy
Sheets("Bullseye").Select
Range("AH3").Select
ActiveSheet.Paste
Columns("AH:AH").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=-18
Sheets("Macro").Select
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:="<0", _
Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-21
Range("A2:A59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bullseye").Select
Range("AK3").Select
ActiveSheet.Paste
End Sub
This code gets the job done but I wanted to change it so that I could have code run that will auto generate all my data in the same way but without having a fixed range. Additionally, I have to delete all the data that this macro fills if I want to run it again.
Basically just trying to cut down the number of steps so that this sheet is fully automated as much as possible.
Thanks!
You can try using a variable. In this case, the variable RowNum finds row number for the last value in column F. You can then substitute the variable RowNum for the number 60 in each place in your code, making your ranges dynamic like this:
Dim RowNum As Integer
RowNum = Sheets("Macro").Cells(Rows.Count, "F").End(xlUp).Row
Range("F2:F" & RowNum).Select
'...
Range("A2:A" & RowNum).Select
you have to avoid all Select/Selection/Activate/ActiveXXX pattern design which is 99,99% unnecessary and switch to fully qualified range references
furthermore you don't need any "intermediate" sheet as your "macro" since you can filter data directly in place
Option Explicit
Sub Variance()
With Worksheets("numbersSheet") '<--| reference your data worksheet (change "numbersSheet" to your actual sheet with numbers name)
With Range("F1", .Cells(.Rows.count, "F").End(xlUp)) '<--| reference its column "F" range from row 1 (header) down to last not empty row
FilterAndWrite .Cells, ">=0", Worksheets("Bullseye").Range("AH3") '<--| filter positive or zero values and write them from Worksheets("Bullseye").Range("AH3") downwards
FilterAndWrite .Cells, "<0", Worksheets("Bullseye").Range("AK3") '<--| filter negative values and write them from Worksheets("Bullseye").Range("AK3") downwards
End With
.AutoFilterMode = False
End With
End Sub
Sub FilterAndWrite(sourceRng As Range, criterium As String, targetRng As Range)
With sourceRng
.AutoFilter Field:=1, Criteria1:=criterium
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cells other than header
.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy '<--| copy filtered cell skipping header
targetRng.PasteSpecial xlPasteValues '<--| paste values in passed target range
End If
End With
End Sub

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

Sort multiple columns by one column

I'm making an email list in Excel with three columns. On the worksheet, I have two buttons, "sort by Name" and "sort by Date added". I would like to sort all three columns by the button chosen so I can find entries faster (I am also entering a separate lookup function later).
Basically, I want the sort function that's already on the toolbar in the worksheet where you can just press it and it knows which column to sort by already. I've seen things for macros and for VBA but all of them are sorting columns by separate parameters, whereas I need these columns linked.
The code produce by the recorder on a Range.Sort method is very verbose and can be chopped down quite a bit to what is essential.
If columns A:C were Name, Email, Date Added then this will sort by Name first, then Date Added.
with worksheets("sheet1") '<~~ set this properly!
with .cells(1, 1).currentregion '<~~ assumes data starts in A2 with a header row in A1:C1
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Key2:=.Columns(3), Order2:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
end with
end with
This will sort by Date Added first, then Name.
with worksheets("sheet1") '<~~ set this properly!
with .cells(1, 1).currentregion '<~~ assumes data starts in A2 with a header row in A1:C1
.Cells.Sort Key1:=.Columns(3), Order1:=xlAscending, _
Key2:=.Columns(1), Order2:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
end with
end with
You can have up to 3 keys. Any more than that and you have to run the routine twice. The opposite of xlAscending is of course xlDescending.
The best way I've found to find something that's already on the toolbar is to use the "Macro Recorder" in a blank/new workbook, and then look at the code.
Are the columns adjacent to each other? Because if so you can use something like this;
//Alright, so this is if you wanted each of the columns to have their
//own values that you are sorting by, if you just want one criteria,
//just use one of the lines
Dim varName as String
Dim varDate as String
Dim varExtra as String
ActiveSheet.Range("A:C").AutoFilter Field:=1, Criteria1:=varName
ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:=varDate
ActiveSheet.Range("A:C").AutoFilter Field:=3, Criteria1:=varExtra
Basically, it's saying for the three columns given, go find the field (which will correspond to a column) indicated and filter by the criteria. You can also use a string value in the Criteria spot instead of a variable.