So I am trying to create a function that will get all the unique values in a range, I'm new vba so I've made an attempt but it doesn't work (#VALUE). I eventually want each value in the array to be output one cell below it.
Here is the Code I wrote
Option Explicit
Function getUnique(dataSet As Range, Column As String)
Dim data() As String
Dim dataSize As Integer
Dim dictionary As Object
Dim i As Long
dataSize = dataSet.Rows.Count
Set dictionary = CreateObject("Scripting.Dictionary")
ReDim data(dataSize)
For i = 1 To UBound(data)
data(i) = dataSet(Column & i).Value
dictionary(data(i)) = 1
Next i
Dim v As Variant
For Each v In dictionary.Keys()
Debug.Print dictionary.Keys
Next v
Your code can work with a few changes, as indicated here:
Function getUnique(dataSet As Range) '<<< remove Column
Dim data() As String
Dim dataSize As Integer
Dim dictionary As Object
Dim i As Long
dataSize = dataSet.Rows.Count
Set dictionary = CreateObject("Scripting.Dictionary")
ReDim data(dataSize)
For i = 1 To UBound(data)
data(i) = dataSet.Cells(i, 1).Value '<<< using Cells
dictionary(data(i)) = 1
Next i
Dim v As Variant
For Each v In dictionary.Keys()
Debug.Print v '<<<
Next v
End Function
If, though, you are attempting to use this Function in a Worksheet cell then it won't work if you attempt to put values into other cells. User-Defined Functions don't work like that and you'll have to make it a Sub and run it on clicking a button, or some other event.
Related
I tried the accepted answer of Loop through cells and add to a range with a little bit of variation, but my Range Arr was never appended.
When I tried to debug through it, it was only the first range. The Union never worked. Why is this?
Source code:
Public Function VisibleRows(InRange As Range) As Range
Dim R As Range
Dim Arr As Range
Dim RNdx As Integer
Dim Count As Integer
For RNdx = 1 To InRange.Rows.Count
Set R = InRange(RNdx)
If R.EntireRow.Hidden = False And R.Value2 <> "" Then
If Arr Is Nothing Then
Set Arr = R
Else
Set Arr = Union(Arr, R)
End If
End If
Next RNdx
VisibleRows = Arr
End Function
I can see a couple of problems with the code:
You're looping row by row, but the expression InRange(RNdx) takes the RNdx'th cell within the range - it goes horizontally first and then vertically. You probably want InRange.Cells(RNDx, 1)
Should be Set VisibleRows = Arr
Your function is returning a Range Object. Range objects are assigned to a variable with the word Set. You are not using this word. Try this, running TestMe().
Option Explicit
Public Sub TestMe()
VisibleRows(Range("A1:A10")).Select
End Sub
Public Function VisibleRows(InRange As Range) As Range
Dim R As Range
Dim Arr As Range
Dim RNdx As Integer
Dim Count As Integer
For RNdx = 1 To InRange.Rows.Count
Set R = InRange(RNdx)
If R.EntireRow.Hidden = False And R.Value2 <> "" Then
If Arr Is Nothing Then
Set Arr = R
Else
Set Arr = Union(Arr, R)
End If
End If
Next RNdx
Set VisibleRows = Arr
End Function
This is the sample result from it:
I am trying to write a VBA function that takes a table with two columns as input. I want to return the elements in column 2 for which the corresponding row in column 1 is 3. Basically the equivalent of a where clause in SQL.
The logic of the code seems fine, however I get a type mismatch error. I declare the function As Variant and the array I want to return is As Variant as well.
Function FilterTable(tableName As String) As Variant
Dim table As range
Dim cell As range
Dim names As range
Dim i As Integer
Dim names_2(100) As Variant
Dim j As Integer
Dim test As String
i = 1
j = 1
Set table = ActiveSheet.range(tableName).Columns(1)
Set names = ActiveSheet.range(tableName).Columns(2)
For Each cell In table.Cells
If cell = 3 Then
names_2(i) = names.Cells(j, 1).Value
i = i + 1
End If
j = j + 1
Next
FilterTable = names_2
End Function
Why do I get a Type Mismatch error, and how can I fix it?
There are a few problems with your code but nothing that should cause a type mismatch unless you have worksheet errors (e.g. #N/A, #DIV/0!, etc) in your data.
You should be aware of what worksheet your table is on; don't rely on activesheet.
A 1-D array defaults as zero-based, not one-based.
You should remove the excess (empty) elements in your array after populating it. Use the Locals window or set a Watch on your array to see it populate and resize as you step through the function with F8.
Option Explicit
Sub main()
Dim n As Variant, i As Long
n = FilterTable("table1")
For i = LBound(n) To UBound(n)
Debug.Print n(i)
Next i
End Sub
Function FilterTable(tableName As String) As Variant
Dim table As Range, names As Range, cell As Range
Dim i As Long, j As Long
Dim names_2 As Variant
i = 0
j = 1
ReDim names_2(100)
Set table = Worksheets("Sheet3").Range(tableName).Columns(1)
Set names = Worksheets("Sheet3").Range(tableName).Columns(2)
For Each cell In table.Cells
If Not IsError(cell) Then
If cell = 3 Then
names_2(i) = names.Cells(j, 1).Value
i = i + 1
End If
End If
j = j + 1
Next cell
ReDim Preserve names_2(i - 1)
FilterTable = names_2
End Function
How to fill an array with strings in VBA and get its lengh?
For example two cells might contain this info:
A1: "test 1"
A2: "test 2"
Dim example As String
Dim arreglito() As String
example = Range("A2").Value
arreglito(0) = example
example= Range("A1").Value
arreglito(1)= example
MsgBox arreglito(0)
subscript out of range
Dim example As String
Dim arreglito() As Variant
example = Range("A2").Value
arreglito(0) = example
MsgBox arreglito(0)
subscript out of range
Here is a method of adding a single column range from the worksheet to a string array (transpose may have some size restrictions. 2^16 is it?).
Have used a line by Flephal to get the range into a string array in one step.
Sub AddToArray()
Dim arreglito() As String
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("MySheet") 'change as appropriate
Dim srcRange As Range
Set srcRange = ws.Range("A1:A3")
arreglito = Split(Join(Application.Transpose(srcRange), "#"), "#")
MsgBox UBound(arreglito) + 1
End Sub
For more than one column transfer via a variant array:
Sub AddToArray2()
Dim arreglito() As String
Dim sourceArr()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("MySheet") 'change as appropriate
Dim srcRange As Range
sourceArr = ws.Range("A1:C3")
ReDim arreglito(1 To UBound(sourceArr, 1), 1 To UBound(sourceArr, 2))
Dim x As Long
Dim y As Long
For x = LBound(sourceArr, 1) To UBound(sourceArr, 1)
For y = LBound(sourceArr, 2) To UBound(sourceArr, 2)
arreglito(x, y) = CStr(sourceArr(x, y))
Next y
Next x
MsgBox UBound(arreglito, 1) & " x " & UBound(arreglito, 2)
End Sub
you can read entire excel range to array, its much faster than reading data from range cell by cell.
Sub testRerad()
Dim arr As Variant 'no brackets needed, I prefer to use variant
Dim numOfRows As Long, numOfCols As Long
arr = Sheets(1).Cells(1).Resize(10, 1).value 'arr will contain data from range A1:A10
'or
arr = Sheets(1).Range("A1").CurrentRegion.value 'arr will contain data from all continous data startig with A1
'get dimensions
numOfRows = UBound(a)
numOfCols = UBound(a, 2)
End Sub
be warned that this will always create multidimensional array (even if only 1 column) with dimensions 1 to y, 1 to x
I am trying to create a macro that reads data and does econometrics on the data. At this point I am trying to implement a latent variable MLE estimation.
The data can be of any length, depending on the user input. Suppose there is data in column O and column P. Ex-ante I have no idea how many rows of data exist.
I would like to first read how many data there are and then upload the data into my array variable before I can do any econometrics/statistics on it.
In this problem, the user has 25 data points for each variable. Some other user may enter different data with different number of data points.
In the code below, I am trying to read the variable "D" into an array. I first count the number of non-empty cells and then create an array of that size and try to read the value of the cells into the array. But I am getting a "type mismatch" error.
I've tried both "Variant" and "Array" types. Variant seems to be working but Array is not.
Sub SampleStats()
Dim Rng As String
Dim Var1(1 To 100) As Double
Dim Var2() As Double
Dim Var3 As Variant
Dim NumElements2 As Integer
Dim length2 As Integer
NumElements2 = WorksheetFunction.Count(Range("P:P"))
length2 = NumElements2+1
MsgBox NumElements2
ReDim Var2(1 To NumElements2)
Rng = "P2:P" & length2
MsgBox Rng
Var3 = Range(Rng).Value
MsgBox Var3(1,1)
Var2 = Range(Rng).Value
MsgBox Var2(1,1)
End Sub
My questions are:
Whats the best way to read data when you don't know how long the columns go?
What the best way to store data (Variant or Array or something else) when the final objective is doing some statistics?
First you get the Range with the column of data you want to pass into the array. Second you use the Application.Transpose function on the data and assign it to a Variant to create a 1-dimensional array from the Range.Value property.
If you just assign the range's Value directly to the Variant you will get a 2-dimensional array of N rows x 1 column. Sample code:
Option Explicit
Sub GetRangeToArray()
Dim ws As Worksheet
Dim rngData As Range
Dim varData As Variant
Dim lngCounter As Long
' get worksheet reference
Set ws = ThisWorkbook.Worksheets("Sheet1")
' get the column to analyse - example here is A2:A last row
' so using 1 in column reference to Cells collection
Set rngData = ws.Cells(2, 1).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp))
' convert range from 2d to 1d array
varData = Application.Transpose(rngData.Value)
' test array
For lngCounter = LBound(varData) To UBound(varData)
Debug.Print varData(lngCounter)
Next lngCounter
End Sub
sub createarraywithoutblanks()
creatary ary, Sheets("Table_Types"), "A":
alternative ary:
BuildArrayWithoutBlanks ary
end sub
Sub creatary(ary As Variant, sh As Worksheet, ltr As String)
Dim x, y, rng As range
ReDim ary(0)
Set rng = sh.range(ltr & "2:" & ltr & sh.range("A10000").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
x = 0
For Each y In rng
ary(x) = y
x = x + 1
ReDim Preserve ary(x)
Next y
End Sub
Function Letter(oSheet As Worksheet, name As String, Optional num As Integer)
If num = 0 Then num = 1
Letter = Application.Match(name, oSheet.Rows(num), 0)
Letter = Split(Cells(, Letter).Address, "$")(1)
End Function
Sub alternative(ary As Variant)
Dim Array_2()
Dim Array_toRemove()
Dim dic As New Scripting.Dictionary
Dim arrItem, x As Long
For Each arrItem In ary
If Not dic.Exists(arrItem) Then
dic.Add arrItem, arrItem
Else
ReDim Preserve Array_toRemove(x)
Array_toRemove(x) = dic.Item(arrItem)
x = x + 1
End If
Next
'For Each arrItem In Array_toRemove
' dic.Remove (arrItem)
'Next arrItem
ary = dic.Keys
End Sub
Sub BuildArrayWithoutBlanks(ary As Variant)
Dim AryFromRange() As Variant, AryNoBlanks() As Variant
Dim Counter As Long, NoBlankSize As Long
'set references and initialize up-front
ReDim AryNoBlanks(0 To 0)
NoBlankSize = 0
'load the range into array
AryFromRange = ary
'loop through the array from the range, adding
'to the no-blank array as we go
For Counter = LBound(AryFromRange) To UBound(AryFromRange)
If AryFromRange(Counter) <> 0 Then
NoBlankSize = NoBlankSize + 1
AryNoBlanks(UBound(AryNoBlanks)) = AryFromRange(Counter)
ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) + 1)
End If
Next Counter
'remove that pesky empty array field at the end
If UBound(AryNoBlanks) > 0 Then
ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) - 1)
End If
'debug for reference
ary = AryNoBlanks
End Sub
I am trying to read an Excel range to a variable of type string.
Currently I have achieved it with a work around. I copied the range to clipboard and used a ReadClipBoard function that reads the clipboard as assigns to variable. This method is not efficient and also some times it gives error due to clipboard issues with VBA.
Workaround Code:
Dim variable as string
Range("A1:C5").Copy
variable = ReadClipBoard()'Function that returns clipboard text
Is there a better way to do it?
This will turn each line into a tab-separated string and the whole range into a line-separated string.
Public Function RangeToText(ByRef r As Range)
Dim vaData As Variant
Dim aOutput() As String
Dim i As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
'Put range into a two dim array
vaData = r.Value
'Make one dim array the same number of rows
ReDim aOutput(1 To UBound(vaData, 1))
'Make strings With tabs out of each row
'and put into one dim array
For i = LBound(vaData, 1) To UBound(vaData, 1)
aOutput(i) = Join(wf.Index(vaData, i), vbTab)
Next i
'join all the strings into one multi-line string
RangeToText = Join(aOutput, vbNewLine)
End Function
In the Immediate Window
?rangetotext(sheet1.Range("A1:C5"))
Here Here Here
is is is
some some some
column 1 column 2 column 3
text text text
The Index worksheet function is used to process only one row at a time because Join requires a one dimensional array
If you are reading more than once cell, then the variable would be an array For example:
Sub ArrayDemo()
Dim r As Range
Set r = Range("A1:C5")
variable = r
End Sub
is nearly equivalent to :
Sub ArrayDemo2()
Dim r As Range
Set r = Range("A1:C5")
Dim variable(1 To 5, 1 To 3) As Variant
For i = 1 To 5
For j = 1 To 3
variable(i, j) = Cells(i, j).Value
Next j
Next i
End Sub
Naive way is to concatenate all the content into a string, is that ok for you?
Function ConcatCells(r as range, optional sep as string) as string
dim c as range
dim s as string
s=""
if sep is missing then sep=" "
for each c in r.cells
s = s & c & sep
next c
s=left(s, len(s) - len(sep))
ConcatCells=s
end sub