How to read a dynamic range? - vba

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

Related

How to fill an array with strings in VBA and get its lengh?

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

Search in Excel using VBA

I need to search a worksheet by a particular value in a specific column. I have to do something with values in other columns of the found rows. What is the most simple and efficient way to get all row numbers that have the search value in that specific column?
Thanks.
You could try something like that:
Public Function Test(str As String, rng As Range) As Variant
Dim xVal As Variant, Arr() As Variant
Dim i As Long
ReDim Arr(0 To 100)
For Each xVal In rng
If xVal.Value = str Then
Arr(i) = xVal.Row
i = i + 1
End If
Next
If i Then
ReDim Preserve Arr(0 To i - 1)
Test = Arr
Else
Test = 0
End If
End Function
(Done by phone. May contain errors.)
If you are looking for happiness in some region of a worksheet, the select that region and run:
Sub FindingHappiness()
Dim s As String, rng As Range, r As Range
Dim msg As String
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
s = "happiness"
For Each r In rng
If InStr(1, r.Text, s) > 0 Then
msg = msg & vbCrLf & r.Row
End If
Next r
MsgBox msg
End Sub
Note that using this technique will allow you to search in a single row, or in a single column, or in a block of cells, or all the cells on a worksheet, or even in a disjoint group of cells.

Excel range to plane string

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

Get unique values out of a range

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.

Count number of different cells in VBA

I want to count no of different cells which are selected using VBA.
Consider if we select five distinct cells - D5, C2, E7, A4, B1.
Is there a way I can count these number of cells.
Secondly how can I retrieve data in these cells. Lets say I want to store it in an array.
Thank you for the help.
Dim rngCell as Range, arrArray() as Variant, i as integer
Redim arrArray(1 to Selection.Cells.Count)
i = 1
For each rngCell in Selection
arrArray(i) = rngCell.Value
i = i + 1
Next
Looks like you got it mostly figured out, but here is something to load it into an array if you want it:
Public Sub Example()
Dim test() As Variant
test = RangeToArray(Excel.Selection, True)
MsgBox Join(test, vbNewLine)
End Sub
Public Function RangeToArray(ByVal rng As Excel.Range, Optional ByVal skipBlank As Boolean = False) As Variant()
Dim rtnVal() As Variant
Dim i As Long, cll As Excel.Range
ReDim rtnVal(rng.Cells.Count - 1)
If skipBlank Then
For Each cll In rng.Cells
If LenB(cll.Value) Then
rtnVal(i) = cll.Value
i = i + 1
End If
Next
ReDim Preserve rtnVal(i - 1)
Else
For Each cll In rng.Cells
rtnVal(i) = cll.Value
i = i + 1
Next
End If
RangeToArray = rtnVal
End Function
Thankfully I got a way around it by doing - Selection.Cells.Count
It returns me the cell count for selected cells.
But I am still stuck with dynamically assigning this value to an array as in ---
I = Selection.Cells.Count Dim ValArr(I)