I have a data table Table1, and this table is usually filtered for one column or another. Behind a button I have code that should select data from the Table1 in the column Account Country, only get the unique country values, copy the visible data, and paste them sorted alphabetically somewhere else. The problem I have is that I can't manage to combine unique with visible.
I have this code that is able to copy unique country labels
Dim tbl1 As ListObject
Set tbl1 = Worksheets("Daily work").ListObjects("Table1")
With tbl1.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Table1[[#All],[Account Country]]"), SortOn:=xlSortOnValues _
, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.Apply
End With
Worksheets("Daily work").Range("Table1[[#All],[Account Country]]").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1006"), Unique:=True
Application.GoTo Reference:="Table1"
Selection.AutoFilter
however, it seems to copy also not visible country values from the table.
I've attempted to add '.SpecialCells(xlCellTypeVisible)' to the code section that copies, but it doesn't seem to work. I get this result, even though I know there is enough data left. The other image shows the data left visible after filtering has occurred. The filter can be different based on what the user has done in the workbook, so I can't add the filtering to the code here
You can't use AdvancedFilter on top of AutoFilter (for what I know) so you either need to use the method #Spectral Instance mentioned or use a Dictionary to store the unique values if you don't want to use the clipboard:
Sub testAdvancedFilterUnique()
Dim tbl1 As ListObject
Dim arr()
Dim rng As Range, ccell As Range
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Set tbl1 = Worksheets("Daily work").ListObjects("Table1")
With tbl1.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Table1[[#All],[Account Country]]"), SortOn:=xlSortOnValues _
, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.Apply
End With
With Worksheets("Daily work")
Set rng = .Range("Table1[[#All],[Account Country]]").SpecialCells(xlCellTypeVisible)
For Each ccell In rng
dict(ccell.Value) = Empty 'if it doesn't exist yet, add it
Next
arr = WorksheetFunction.Transpose(dict.keys())
.Range("A1006").Resize(UBound(arr, 1)).Value = arr 'paste all values in one go
End With
' Application.Goto Reference:="Table1"
' Selection.AutoFilter
End Sub
Related
I found this code on these forums. I have been trying to manipulate the code for what I need to do, but I am struggling with 1 piece. In particular, I want the parameters to be:
Sorts by: Column B;
Sort on: Cell values;
Order: Largest to Smallest.
The problem I am struggling with is how to get it to sort by column B. I think it is sorting by column D at the moment; which, is the last column in the excel file I am working within. But, I need it to sort by column B, and can't figure out how to change it to do so. Does anyone know how to manipulate the code below to ALWAYS sort by column B?
Sub RangeSelectionPrompt()
Dim rngStart As Range
Dim WS As Worksheet
On Error Resume Next
Set rngStart = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
Err.Clear
On Error GoTo 0
If rngStart Is Nothing Then
MsgBox "User cancelled"
Else
Set WS = rngStart.Parent
WS.Sort.SortFields.Clear
With rngStart
WS.Sort.SortFields.Add Key:= _
.Columns(.Columns.Count), SortOn:=xlSortOnValues, Order:= _
xlDescending, DataOption:=xlSortNormal
End With
With WS.Sort
.SetRange rngStart
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End Sub
The key element of your rngStart.WS.Sort.SortFields element define how to sort the data.
With the command WS.Sort.SortFields.Add, you add a sorting key to the sort function. You could add several keys to it (to sort first the column A, then the column B).
Assuming the range you want to sort is starting with the column A, and you want it sorted by column B, you may want to use #BigBen solution, and set your key to .Columns(2).
The next parameter of this key will let you decide how the sorting happens: SortOn:=xlSortOnValues, Order:= xlDescending,. You cna understand that the sorting will be based on value. and descending. So it should be the way you want it.
You can find much more information about how the sortfield methods here: https://learn.microsoft.com/en-us/office/vba/api/excel.sortfields.add
I am sorting the following columns independently and in descending order, i.e. the largest value in each column will always be in the top row. However, I have several blank cells in the table.
These are not actually blank, but rather the index/match formula references another formula cell IFERROR(H2/I2,"") that gives a blank answer. I wish to sort the blank cells at the bottom of each column when performing the descending sort.
How can I amend the following VBA code to allow for this? I would prefer the solution to be more generic, and also take care of the situation whereby I am sorting both positive and negative numbers in the filled cells in descending order.
Sub SortIndividualCol()
Dim xRg As Range
Dim yRg As Range
Dim ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next
Set xRg = Application.InputBox(Prompt:="Range Selection:", _
Title:="Input header range", Type:=8)
Application.ScreenUpdating = False
For Each yRg In xRg
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=yRg, Order:=xlDescending
.SetRange ws.Range(yRg, yRg.End(xlDown))
.Header = xlYes
.MatchCase = False
.Apply
End With
Next yRg
Application.ScreenUpdating = True
Before sorting:
After descending sort, but blank cells are sorted to the top:
This is a basic loop that will loop and sort each column independently. Disclaimer Row data integrity will not be maintained.
For x = 1 To 5 'adjust to the number of columns you want to sort
With ActiveSheet.Sort 'I prefer to use the actual sheet name
.SortFields.Clear
.SortFields.Add .Parent.Columns(x), Order:=xlDescending
.SetRange .SetRange .Parent.Cells(1, x).Resize(6) 'you can use a last row variable -1
.Apply
End With
Next x
In short, I have about five hundred or so columns, all of which to sort alphabetically (with headers). Although this may have an easier solution involving highlighting the entire dataset and doing a custom sort of some sort.... I've taken a stab at writing a script for it. What I have so far is:
Sub ColumnSort()
Dim Rng As Range
Dim i As Long
Dim aCell As Range
i = 0
Set Rng = Range("D:D")
While i <= 5000
Rng.Offset(0, i).Sort Order1:=xlAscending, Header:=xlYes
i = i + 1
End
Wend
End Sub
You can probably see my reasoning, but the line Rng.Offset(0, i).Sort Order1:xlAscending, Header: =xlYes is giving me an error. Is this the correct syntax to use for this particular problem? Is there a better way to do this?
thanks,
Here's an example of how you would sort columns 1-500 individually:
Dim col As Integer
Dim r As Range
Dim ws As Worksheet
Set ws = ActiveSheet
For col = 1 To 500
Set r = Cells(1, col).EntireColumn
With ws
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange r
.Apply
End With
End With
Next col
There are a lot of other settings you can apply, depending on your data and how you want to handle things (ie does your data have headers).
I can never remember them all -- what I would usually do from here is record a macro with the settings I want and then manually peel them out and add them to the code above.
For example, if you wanted to sort descending, you would have to add Order:=xlDescending to the inner With clause.
I am very new to VBA macros for excel. This site has been extraordinarily helpful thus far.
I have a macro that adds four column headings after the last column, then fills these columns if a certain criteria is met, that part works fine. Before the columns can be filled I need to sort the data. My current method for sorting the data is based off of recording a macro, and changing the needed variables. I have read that often excel records macros very inefficiently. I kind of frankensteined this together. The following code works.
Sub ineffiecientway()
Dim colltr As String
colltr = Replace(Cells(1, LastColumn).Address(True, False), "$1", "") '<-Input column index, returns column letter
Columns("A:" & colltr).Select
ActiveWorkbook.Worksheets("DSEG").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DSEG").Sort.SortFields.Add Key:=Range("A:A") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DSEG").Sort.SortFields.Add Key:=Range("J:J") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("DSEG").Sort
.SetRange Range("A:" & colltr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
The code below is what I have been working on, and pulling my hair out. I'm sure I am making a million rookie mistakes. I think this may all be about syntax for .sort that I am failing at.
Note:
GCI() is a user defined fucntion that searches for the input in row one and returns the column index
LastRow() is a user defined function that returns the last row of the column index that is input.
LastColumn just returns the last used column in row one
Sub ThisDoesntWork()
Dim ws As Worksheet
Dim rngAll As Range
Dim Col1 As Long 'for sort key1
Dim Row1 As Long
Dim Col2 As Long 'for sort key2
Dim Row2 As Long
Dim rng1 As Range
Dim rng2 As Range
Dim LastCell As Range
Set ws = Worksheets("DSEG")
Set LastCell = ws.Cells(LastRow(LastColumn), LastColumn)
Col1 = GCI("CDate")
Row1 = LastRow(Col1)
Col2 = GCI("Start Time")
Row2 = LastRow(Col2)
Set rngAll = ws.Range(ws.Cells(1, 1), LastCell)
Set rng1 = ws.Range(ws.Cells(1, Col1), ws.Cells(Row1, Col1))
Set rng2 = ws.Range(ws.Cells(1, Col2), ws.Cells(Row2, Col2))
MsgBox rng1.Address
MsgBox rng2.Address
MsgBox rngAll.Address
With rngAll
.Sort key1:=Range(rng1), order1:=xlAscending, DataOption1:=xlSortNormal, _
key2:=.Range(rng2), order2:=xlAscending, DataOption2:=xlSortTextAsNumbers, _
Header:=xlYes
End With
When I run this code it stops at the ".sort" with the error "Run-time error '1004': Method "Range' of object'_Global' failed
I have also tried with "DataOption1:=xlSortNormal" because I don't believe the first range needs to be sort text as numbers, both cause the same error.
I was trying the above code without setting ranges or "Dim"ing worksheet and thought that setting the ranges prior to running the code would help.
I added MsgBox for the ranges to make sure they are the ranges I want.
First MsgBox returns $A$1:$A$38061
Second MsgBox returns $J$1:$J$38061
Third MsgBox returns $A$1:$S$38061
The first two are the ranges that I want to sort by, the last is the range of all the data I want to sort, these are the correct ranges.
Any advice or help getting this working would be greatly appreciated. Also, any advice on better posting, because I'm sure a made mistakes on the "Proper posting format" as well.
Edit: Thanks Nanashi, I will not repeat functions, I appreciate the tip.
Thanks Jeeped. The Current region bit cleaned it up a lot. And it was the .columns that fixed the error (I was trying .range) Million thanks to you both. The working code is below.
Dim ws As Worksheet
Dim Col1 As Long
Dim Col2 As Long
Set ws = Worksheets("DSEG")
Col1 = GCI("CDate") 'searches string and returns column index
Col2 = GCI("Start Time") 'searches string and returns column index
With ws.Cells(1, 1).CurrentRegion.Cells
.Sort key1:=.Columns(Col1), order1:=xlAscending, DataOption1:=xlSortNormal, _
key2:=.Columns(Col2), order2:=xlAscending, DataOption2:=xlSortTextAsNumbers, Header:=xlYes
End With
Typically, any region I .Sort does not have any fully blank rows or columns breaking up the .CurrentRegion so I use that to define the range to be sorted. The .Cells(1,1).CurrentRegion is the equivalent of selecting A1 and tapping Ctrl+A. It encompasses the island of data that expands from A1 until it reaches a fully blank column to the right or a fully blank row down.
Sub prettyefficient()
With Sheets("DSEG").Cells(1, 1).CurrentRegion.Cells
.Sort Key1:=.Columns(1), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers, _
Key2:=.Columns(10), Order2:=xlAscending, DataOption2:=xlSortTextAsNumbers, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
End Sub
You can use up to three keys (Key1, Key2 & Key3) in a single command. If you require more than that, break it into two commands.
I would like to create a button that will look for a value in a particular column and filter by it.
I have 7 columns with data and on the top row i would like to create something like a search bar/ column filtering button. The idea is enter a value in Cell B2 and click a button to have the column G sorted by the value in B2.
Is this possible?
If I understand correctly that by "sort" you mean "filter", then you can do the following.
Create a button on your sheet (Developer tab on the ribbon, insert... button),
and when prompted, add the following code to the Button_Click() Sub :
Private Sub CommandButton1_Click()
[G:G].AutoFilter Field:=7, Criteria1:=Range("b2").Value
End Sub
Be careful that you don't put your button on a row that might get "filtered" or it will disappear. Also, if your "sort on this value" field is in row 2, it might disappear as well.
I'm sure you can figure out how to deal with those things.
Alternative interpretation of question
If instead you are looking to sort on a particular column, whose name is given in cell B2, then your code might look something like this:
Option Compare Text
Sub Button1_Click()
Dim sortCol As Integer
Dim headerRange As Range
Dim sortRange as Range
' assuming data to be sorted is in columns E through K
set headerRange = [E1:K1] ' or wherever the headers are
sortCol = WorksheetFunction.Match([B2].Value, headerRange)
' this line for debug:
set sortRange = [E:E].Offset(, sortCol - 1)
MsgBox "you will sort by column " & sortRange.Address
With ActiveSheet
.Range("E:K").Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=sortRange, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("E:K")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub