If you have variables and values in vba
is it possible to sort them from max to min, but also to match them with variables.
So for example if you have in VBA:
Sub sort()
...
x = 5
y = 3
z = 8
...
End sub
That in excel you get (in A column variables, in B column values):
A B
z 8
x 5
y 3
It's pretty easy to sort 8, 5, 3.
But how to add z, x, y in their proper positions?
AFAIK there isn't any way to do exactly what you are asking. Variable names are part of your code; using and accessing them as data would need reflection which is not something Excel VBA offers*.
But I don't think what you are asking is the best way to achieve what you want by a long way. What you seem to need is a way of storing (name, value) pairs and accessing both the name and the value. One straightforward way to do this is to use the Dictionary object.
There are alternatives if you need different functionality, e.g. using a pair of Arrays (one to hold the names, one to hold the values) - to make this neater you could write a class to keep the two together and implement whatever functions you need as methods.
Once you have the (name,value) pairs outputting them in a sorted list is straightforward. The simplest way is to write them to the spreadsheet and then use Excel's built-in Range.Sort (see MSDN documentation).
Putting it all together (note this needs a reference to the Microsoft Scripting Runtime library for the Dictionary object):
Dim dict As New Dictionary
Dim ws As Worksheet, rng As Range
Dim ky As Variant, itm As Variant
Set ws = ThisWorkbook.Worksheets(1)
'Add items to dictionary
dict.Add "x", 5
dict.Add "y", 3
dict.Add "z", 8
'You can use these in code like this:
For Each ky In dict.Keys
Debug.Print "The value of " & ky & " is " & dict(ky)
Next ky
'you can change values
dict.item("z") = 10
dict.item("z") = 8
'Output the values and keys (the key/value arrays are horizontal while
'the range is vertical, hence transpose)
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(dict.Count, 2))
rng.Columns(1).Value = Application.Transpose(dict.Keys)
rng.Columns(2).Value = Application.Transpose(dict.Items)
'Sort them
rng.Sort Key1:=ws.Range("B1"), Header:=xlNo
*not easily anyway - there are some objects accessible through VBProject which allow limited access to the code. But using that to do what you are asking for would be nigh on impossible.
In VBA there is no such thing as order between variables. You can determine if x is bigger than y, but that doesn't help you since you want them in a specific order.
My answer is not exactly what you are asking for, but I suspect it'll help you anyway.
Since you've got your output to the sheet, albeit unsorted, it is easier to sort it there. Simply sort columns A and B together with column B as primary.
Doing this in code is a bit more complex. You would need to put both name (x, y, z) and value(8, 5, 3) in an array and then sort your array. How to sort arrays have been describe several times before (like here: Excel VBA Quickest way to sort an array of numbers in descending order?)
Related
Let's say I have very large set of data with over 100,000+ rows. In Column A, I want to find each unique number.
I understand this can be done using the .Find feature and Collections/Arrays but those seem to take a good bit of time - especially with 100,000+ rows.
However, after AutoFiltering Column A, when I hit the down arrow it displays only unique variables. Is it possible to simply extract those values out of the selections in this way?
'pseudocode
filter.Count
Dim X As Long
For x = 2 to filter.Count
Cells(x, 14) = filter(x)
Next x
You can use advanced filter, it's pretty darn quick. I tried it with 127k rows, the results were instant.
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
You can extract the visible cells in to an array. Say your total range (without filter) is A2:A10000. Run your filter, then you can run this macro:
Sub t()
Dim arr() As Variant
arr = Range("A2:A10000").SpecialCells(xlCellTypeVisible)
Dim i As Long
For i = LBound(arr) To UBound(arr)
Debug.Print (arr(i, 1))
' Do things with each entry in array
Next i
End Sub
Im working on a project report for work and I'm trying to find a way to compare two lists of project codes i.e "123456" and see whether the 2nd list is missing any new values that would've been entered into the first list. The lists are thousands of records long and so far people have been doing it manually (it hurts me knowing this) so I'm trying to make it automatic.
What I have tried is using an Array with a Index(Match(CountIF))) formula but I just cant seem to get it working.
My problem is that when I get the array to fill with what i want I then can't get it to not duplicate values (I need it to check the masterlist so it doesnt output something more than once into the output list).
I've also tried to give it a go with other formulas - but the lists can be thousands of records long so I cant do a cell for cell match as the list would be huge (that or my excel knowledge isnt good enough to know the easy solution).
Any help would be hugely appreciated.
Array might not be the best solution
I've checked quite a few other solutions but they don't quite deal with my issue and I don't have the skill to adapt them.
Here is one approach using VBA and arrays which is quicker than doing via the sheet. It checks each item in H to see it is present in J (and not the other way round). I assume that's what you want.
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
v2 = Range("J2", Range("J" & Rows.Count).End(xlUp)).Value
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
Using an input box
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Application.InputBox("First list", Type:=8)
v2 = Application.InputBox("Second list", Type:=8)
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
A formula solution.
Note that I turned the first two ranges into Tables and changed the names. The formula is using structured references. This enables the formula to auto update if you add rows in the future.
=IFERROR(INDEX(ProjList1[#Data],AGGREGATE(15,6,1/ISNA(MATCH(ProjList1[#Data],ProjList2[#Data],0))*ROW(ProjList1[#Data]),ROWS($1:1))-ROW(ProjList1[#Headers])),"")
How does it work? Briefly:
MATCH generates an array of #NA! errors or a number.
ISNA turns that into an array of TRUE/FALSE where TRUE indicates an entry in table 1 that is NOT in table 2
Multiplying that array by the array of project list rows returns an array of error message vs row number
AGGREGATE small function ignores the error returns to give an ascending list of row numbers
INDEX then returns the appropriate entry from Table 1
ROW(ProjList1[#Headers]) is a correction so that the table may be located anyplace on the worksheet, and still return the correct row.
Not sure if you're trying to set this up so it will autoupdate in future, but as a stopgap:
Countif column next to list 1 that checks whether they appear in list 2...
... Feeding into a pivot that only shows those where the countif value is 0, in the "row" field to remove duplication?
My research shows that I need to use Visual Basic. I am a programmer/developer, but have never used VB so if anyone could dumb it down it would be appreciated.
Here's my working excel function:
=IF(MATCH(1,E1:DP1,0),D1,FALSE)
I want to loop a few of those numbers such that:
=IF(MATCH(141,E1:DP378,0),D378,FALSE)
THEN take my answers (which will be strings, because column D are all strings, the rest of the excel file are numbers)
=CONCAT
end goal: have 141 String arrays populated based on the data in my table.
I went ahead and made my first attempt at VBA like this:
Sub myFunc()
'Initialize Variables
Dim strings As Range, nums As Integer, answer() As Variant, listAnswers() As Variant
'set variables
strings = ("C1:C378")
nums = 141
i = 0
j = 0
ReDim Preserve answer(i)
ReDim Preserve listAnswers(j)
'answer() = {""}
'for each in nums
For counter = 0 To nums
ReDim Preserve listAnswers(0 To j)
'set each list of answers
listAnswers(i) = Join(answer(), "insertJSONcode")
j = j + 1
'for each in Stings
For Each cell In strings
If cell <> "" Then
ReDim Preserve answer(0 To i)
answer(i) = 'essentially this: (MATCH(2,E1:DP1,0),D1,FALSE)
i = i + 1
end If
next cell 'end embedded forEach
Next LCounter 'end for loop
'is this possible? or wrong syntax?
Range("A:A").Value = listAnswers() ' should print 141 arrays from A1 to A141
End Sub
EDIT:
Important note I do NOT need to call the sheet by Name. I've successfully written integer values to by excel sheet in column A without doing so.
Also, the VBA I wrote I was never intended to work, I know it's broken at least where answer(i) is supposed to write to something. I'm only putting that code there to show I was able to at least able to get into spitting distance of the proper logic and prove I've put some serious effort into solving the problem and give a rough starting point.
Here's an image of the excel format. Column C goes down to 378 and the numbers listed from E through DP are populated by a database. It consists of blank cells and numbers between 1 and 141.
Looking back at my if statement:
=IF(MATCH(2,E2:DP2,0),D2,FALSE)
If I were to type that exactly into cell B2 it would output the correct answer "text2". which is neat and all, but I need every instance of text 2 written out, then CONCAT those results. Easy so far, I could drag that down all the way through column B and have all of my "text" strings in one column, CONCAT that column and there's the answer. However I don't just need #2, I need each number between 1 and 141. Plus I want to avoid writing 141 columns with a CONCAT on top of each one.
A lot of the solutions here on SO involve using CountIf to find duplicates. When I have a list of 100,000+ values however, it will often take minutes for CountIf to search for duplicates.
Is there a quicker way to search for duplicates within an Excel column WITHOUT using CountIf?
Thanks!
EDIT #1:
After reading the comments and replies I realize I need to go into greater detail. Let's pretend I'm a birdwatcher, and after I return from a birdwatching trip I input anywhere from 1 to 25 or 50 new birds that I saw on my trip into my "Master List of Birds Seen". This is really a dynamically growing list, and with each addition I want to make sure I'm not duplicating something that already exists in my list.
So, in column A of my file are the names of the birds. Column B-M might contain other attributes of the birds. I want to know if a bird that I just added in column A after my latest birdwatching trip ALREADY exists somewhere ELSE in my list. And, if it does, I would manually merge the data of the 2 entries and throw away some and keep some after careful review. I clearly don't want to have duplicate entries of the same bird in my database.
So, ultimately I want some indication that there is or isn't a duplicate somewhere else, and if there is duplicate please tell me what row to look in (or highlight or color both of the duplicates).
The fastest way that I know of (in case you are using Excel 2007/2010/2011) is to use Data (In Ribbon) | Remove Duplicates to find the total number of duplicates OR to remove duplicates. You might want to move data to a temp sheet before you test this.
The 2nd fastest way is to use Countif. Now Countif can be used in many ways to find duplicates. Here are two main ways.
1) Inserting a New Column next to the data and putting the formula and simply copying it down.
2) Using Countif in Conditional formatting to highlight cells which are duplicates. For more details, please see this link.
suggestions for a macro to find duplicates in a SINGLE column
EDIT:
My Apologies :)
Countif is the 3rd fastest way!
The 2nd fastest way is to use Pivot Tables ;)
What exactly is your main purpose of finding duplicates? Do you want to delete them? Or Do you want to highlight them? Or something else?
FOLLOWUP
Seems like I made a typo in the formula. Yes for large number of rows, CountIf does take minutes as you suggested.
Let me see if I can come up with a VBA code to suit your exact needs.
Sid
You can use VBA - the following function returns a list of unique entries within a list of 100,000 in less than a second. Usage: select a range, type the formula (=getUniqueListFromRange(YourRange)) and validate with CTRL+SHIFT+ENTER.
Public Function getUniqueListFromRange(parRange As Range) As Variant
' Returns a (1 to n,1 to 1) array with all the values without duplicates
Dim i As Long
Dim j As Long
Dim locKey As Variant
Dim locData As Variant
Dim locUniqueDict As Variant
Dim locUniqueList As Variant
On Error GoTo error_handler
locData = Intersect(parRange.Parent.UsedRange, parRange)
Set locUniqueDict = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 1 To UBound(locData, 1)
For j = 1 To UBound(locData, 2)
locKey = UCase(locData(i, j))
If locKey <> "" Then locUniqueDict.Add locKey, locData(i, j)
Next j
Next i
If locUniqueDict.Count > 0 Then
ReDim locUniqueList(1 To locUniqueDict.Count, 1 To 1) As Variant
i = 1
For Each locKey In locUniqueDict
locUniqueList(i, 1) = locUniqueDict(locKey)
i = i + 1
Next
getUniqueListFromRange = locUniqueList
End If
error_handler: 'Empty range
End Function
If using Excel 2007 or later (which is likely from the 100,000+ values) you can choose:
Home Tab | Conditional Formatting > Highlight Cell Rules > Duplicate Values...
Right-click a highlighted cell and filter by selected cell color to show just the duplicates (be aware however this can be slow with conditional formatting).
Alternatively run this code and filter for colored cells which takes only a second on 100,000 cells:
Sub HighlightDupes()
Dim i As Long, dic As Variant, v As Variant
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In Selection.Value2
If dic.exists(v) Then dic(v) = "" Else dic.Add v, i
i = i + 1
Next v
Selection.Font.Color = 255
For Each v In dic
If dic(v) <> "" Then Selection(dic(v)).Font.Color = 0
Next v
End Sub
Addendum:
To select only duplicate values without code or formulas, i have found this method useful:
Data Tab | Advanced Filter... Filter in Place, Unique Records Only, OK.
Now select the range of unique values and press Alt+; (Goto Special... Visible cells only). With this selection clear the filter and you will see that all unselected cells are duplicates, you can then press Ctrl+9 (Hide Rows) to show just the duplicates. These rows can be copied to another sheet if needed or marked with an "X".
You do not mention what you want to do when you find them. If you merely want to see where they are...
Sub HighLightCells()
ActiveSheet.UsedRange.Cells.FormatConditions.Delete
ActiveSheet.UsedRange.Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=ActiveCell
ActiveSheet.UsedRange.Cells.FormatConditions(1).Interior.ColorIndex = 4
End Sub
Preventing Duplicates with Data Validation
You can use Data Validation to prevent you entering duplicate bird names. See Debra Dalgelish's site here
Handling existing duplicates
My free Duplicate Master addin will let you
Select
Colour
List
Delete
duplicates.
But more importantly it will let you run more complex matching than exact strings, ie
Case Insensitive / Case Sensitive searches (sample below)
Trim/Clean data
Remove all blank spaces (including CHAR(160)) see the " mapgie" and "magpie" example below
Run regular expression matches (for example the sample below replaces s$ with "" to remove plurals)
Match on any combination of columns (ie Column A, all columns, Column A&B etc)
I'm surprised that no one has mentioned the RemoveDuplicates method.
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1
This will simply remove any duplicate entries on the active worksheet in column A. It takes milliseconds to run (tested with 200k rows). Mind you, this will strictly delete all the duplicate entries. Although that isn't how the original question was worded, I do believe that this still serves your purpose.
One simple way of finding unique values is to use the advance filter and filter for unique values only and copy and paste them into other sheet as when the pivot is removed you will get the whole data with the duplicate in them.
Sort the range
and in next column put `=if(a2=a1;1;if(a2=a3;1;0))
"1" will be displayed for duplicates.
I have a loop wherein I take the mean of several columns of numbers with the same number of rows each.
The point of the loop is to capture these means in a new vector.
So for each loop I need to indicate "all rows". In matlab this would be easy, just use ":" But I can't figure out what the analogy is in VB. Please help! Thanks.
(Please advise me as to what I put in the code below where I have ALLROWS).
My attempt so far:
For i = 1 To CA
mrCA11(i) = Application.WorksheetFunction.Average(revCA11(**ALLROWS**,i))
Next i
In matlab this would be:
For i = 1:CA
mrCA11(i) = mean(revCA11(:,i));
Next i
EDIT: I've also tried this trick to no avail:
For j = 1 To CA
For i = 1 To s11
temp11(i) = revCA11(i, j)
Next i
mrCA11(j) = Application.WorksheetFunction.Average(temp11)
Next j
I get the error message: "Unable to get the Average property of the Worksheet Function class"
As everybody (Tim and shahkalpesh at least) pointed out, we need to understand what is revCall or more specifically, we need to understand how you want to give them ALL ROWS in argument.
Finding the last row (or column or cell)
A common Excel issue is to find the last used row / column / cell.
This will give you the end of your vector.
Excel give you several methods to deal with this:
xlTypeLastCell
Last cell used in the entire sheet (regardless if it's used in column A or not)
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End(xlUp)
Last cell used (including blanks in-between) in Column A is as simple as this:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
End(xlToLeft)
Last cell used (including blanks in-between) in Row 1 is as simple as this:
lastRow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Row
UsedRange
Last cell used in the WorkSheet (according to Excel interpretation):
Set rangeLastCell = ActiveSheet.UsedRange
Using an array as argument
The methods above told you how to find the last row (if this is what you need). You can then easily create your vector and use it in your procedure revCA11.
You can either give an array as argument as Tim pointed out in his answer with this kind of statement:
myArray = ActiveSheet.Range("A1", Cells(lastRow, lastColumn).Value
Or you can use the integer (or long) to build your vector inside your procedure as simple as declaring a range:
Range("A1:A" & lastRow)
You might clarify exactly how revCA11 is declared/created, but maybe something along these lines might work for you:
Sub Tester()
Dim arr, x
arr = ActiveSheet.Range("A1:D5").Value '2-D array
'average each column
Debug.Print "Columns:"
For x = 1 To UBound(arr, 2)
Debug.Print x, Application.Average(Application.Index(arr, 0, x))
Next x
'average each row
Debug.Print "Rows:"
For x = 1 To UBound(arr, 1)
Debug.Print x, Application.Average(Application.Index(arr, x, 0))
Next x
End Sub