I am working on a program that needs to read an array of values from cells in another worksheet in the same workbook. I am able to read a single value just fine, but when I try to read multiple, I cannot return an array.
Here is what I am trying to do:
Dim list() As Variant
list = ActiveWorkbook.Worksheets("Sheet2").Range("A2:C2").value
Debug.Print TypeName(list)
Debug.Print UBound(list)
Debug.Print LBound(list)
Debug.Print TypeName(list(UBound(list)))
For which the output is:
Variant()
1
1
Subscript out of range
However, If I try it where I expect a single string, instead of an array of strings
Dim value As String
Let value = ActiveWorkbook.Worksheets("Site IDs and CJONs").Range("A2").value
Debug.Print TypeName(value)
Debug.Print value
for which I get the output
String
Expected Value
According to this question I should be able to simply return an array from the range function (example from the answer below), but it doesn't seem to be working for me. What am I doing wrong?
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
Although it is not obvious, this:
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
actually is like:
Dim DirArray(1 To 5, 1 To 1) As Variant
DirArray(1, 1) = Range("A1").Value
DirArray(2, 1) = Range("A2").Value
DirArray(3, 1) = Range("A3").Value
DirArray(4, 1) = Range("A4").Value
DirArray(5, 1) = Range("A5").Value
Pulling a set of cells into an array usually makes a 2-D array.
NOTE:
If you want to go from array to worksheet cells then, for example:
Sub ytrewq()
Dim DirArray(1 To 5, 1 To 1) As Variant
DirArray(1, 1) = "Larry"
DirArray(2, 1) = "Moe"
DirArray(3, 1) = "Curly"
DirArray(4, 1) = "Shepp"
DirArray(5, 1) = "James"
Range("B9").Resize(5, 1) = DirArray
End Sub
I might as well put my comment as an answer:
Option Explicit
Sub test()
Dim list As Variant
list = Application.Transpose(Application.Transpose(ActiveWorkbook.Worksheets("Sheet1").Range("A2:C2").Value))
Debug.Print TypeName(list)
Debug.Print UBound(list)
Debug.Print LBound(list)
'Debug.Print UBound(list, 2) Error
'Debug.Print LBound(list, 2) Error
Debug.Print TypeName(list(UBound(list)))
Debug.Print list(UBound(list))
End Sub
Gives output:
Variant()
3
1
String
x
where C2 contains letter x.
Related
I've got the following:
Dim dupArray As Variant
dupArray = Array("dup")
For j = LBound(numArray) To UBound(numArray)
If IsInArray(Range(numArray(j)).Text, dupArray) Then
Range(numArray(j)).Interior.ColorIndex = 3
MsgBox "Duplicate value"
ElseIf IsInArray(Range(numArray(j)).Text, keyArray) Then
Application.OnKey Range(numArray(j)).Text, comArray(j)
ReDim Preserve dupArray(j)
Dim cellEntry As String
cellEntry = Range(numArray(j)).Text
MsgBox cellEntry
dupArray(j) = cellEntry
Else
Range(numArray(j)).Interior.ColorIndex = 3
MsgBox "Unrecognized key code in " & numArray(j)
End If
Next j
In essence, I want VBA to read the contents of a cell and append them to an array for comparison. Code to read the contents of a cell is Range(numArray(j)).Text... For some reason, cellEntry and dupArray(j) are not equal. More specifically, for the cell A6, cellEntry is "b" (which is the correct contents), but dupArray(j) is "A6"... any thoughts? There's no error code, it's just not putting the correct value in the array.
Thank you!
(Edit) Code for Function IsInArray:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
(Edit 2) Don't pay attention to much else... I'm just wondering why cellEntry doesn't match dupArray(j) for all values of j when they should clearly be the same thing.
Your code seems to work, but it depends on keyArray being populated.
I've run this demo code, including populating numArray and keyArray with test values, to illustrate what happens.
If how I've populated these arrays doesn't match your code, please add that info to your Q.
Sub Demo()
Dim dupArray As Variant
Dim numArray As Variant
Dim keyArray As Variant
Dim comArray As Variant
Dim j As Long
' for testing
numArray = Application.Transpose([A1:A6].Value)
ReDim keyArray(1 To 3)
keyArray(1) = "x"
keyArray(2) = "a"
keyArray(3) = "s"
dupArray = Array("dup")
For j = LBound(numArray) To UBound(numArray)
If IsInArray(Range(numArray(j)).Text, dupArray) Then
Range(numArray(j)).Interior.ColorIndex = 3
'MsgBox "Duplicate value"
ElseIf IsInArray(Range(numArray(j)).Text, keyArray) Then
'Application.OnKey Range(numArray(j)).Text, comArray(j)
ReDim Preserve dupArray(j)
Dim cellEntry As String
cellEntry = Range(numArray(j)).Text
'MsgBox cellEntry
dupArray(j) = cellEntry
Else
Range(numArray(j)).Interior.ColorIndex = 4 ' changed to be distinct for testing
'MsgBox "Unrecognized key code in " & numArray(j)
End If
Next j
End Sub
Sheet, before
Sheet, after
Variable values at end of execution
As you can see, dupArray has been populated sparsley, in line with numArray. This is fine for how it's used with IsInArray. If it's used for something else too, you can change how it's populated.
I want to count how many times appear the parameters CA, CU and CH, in an excel that looks like this:
I have tried to use the following code, but as the cells don't contain only the parameter I am searching for, it doesn't work:
Sub ContarOV()
Dim cont As Variant
Dim sumaCA As Variant
Dim sumaCU As Variant
Dim sumaCH As Variant
sumaCA = 0
sumaCU = 0
sumaCH = 0
For cont = 3 To 12
If Cells(cont, 2) = ("CA") Then
sumaCA = sumaCA + 1
End If
If Cells(cont, 2) = ("CU") Then
sumaCU = sumaCU + 1
End If
If Cells(cont, 2) = ("CH") Then
sumaCH = sumaCH + 1
End If
Next cont
End Sub
As per #BigBen, I would try to avoid any iteration. What about one of the following options (assuming your data sits from A2:A?):
Sub Test()
Dim lr As Long, x As Long
Dim arr As Variant
Dim rng As Range
With Sheet1 'Change according to your sheets CodeName
'Get last used row
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
'Get data into memory for method 1
arr = Application.Transpose(.Range("A2:A" & lr).Value)
'Create range object for method 2
Set rng = .Range("A2:A" & lr)
'Method 1: Count values with FILTER
Debug.Print UBound(Filter(arr, "CA")) + 1
Debug.Print UBound(Filter(arr, "CU")) + 1
Debug.Print UBound(Filter(arr, "CH")) + 1
'Method 2: Count values with COUNTIF
Debug.Print WorksheetFunction.CountIf(rng, "CA*")
Debug.Print WorksheetFunction.CountIf(rng, "CU*")
Debug.Print WorksheetFunction.CountIf(rng, "CH*")
End With
End Sub
Btw, I would give sumaCA and your other variables a meaningfull data type, Long in this case.
You can use InStr() to return the position of the desired characters in the string. This would look something like If Not InStr(1, Cells(cont,2).Text, "CH") = 0 Then, but looping through strings is generally a slow process. Unless you have a specific need for looping, I like BigBen's answer a lot better than I like looping with InStr().
I am trying to get the values of the visible cells of a range into an array.
My code makes the array carry the values until the first non visible cell then stops.
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
ListeMaschinen = Auswahl
End Function
If I select the range it shows all the cells I want marked.
Auswahl.Select
Here I have added the range cells to an array.
Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub
In your code, you are setting a Variant variable equal to a Range object without using the Set statement.
The following works with the little testing I did. Of course, if you declare the function type and other variables as Range type, it also works.
Option Explicit
Sub test()
Dim myVar As Variant
Set myVar = myList()
Debug.Print myVar.Address
End Sub
Public Function myList() As Variant
Dim myRng As Range
With Sheets("Sheet1")
Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
Debug.Print myRng.Address
Set myList = myRng
End Function
I think your issue is related to
.SpecialCells(xlCellTypeVisible)
When I do this:
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
'Auswahl.Select
End Function
I get an Address composed of 2 parts: the visible parts!
But when I remove the SpecialCells
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
End Function
I get one single part, which Is what I get when using Select too.
I tested!
Sub test()
Dim myVar As Variant
Dim i As Integer
i = 0
Set myVar = ListeMaschinen()
For Each C In myVar
i = i + 1
MsgBox C.Value & C.Address & "-" & i
Next
End Sub
Further to my comments earlier, here is a method that will work subject to some limitations:
You can't have more than 65536 rows of data; and
You can't have really long text (911 chars+), or blank visible cells; and
The data should not contain the string "|~|"
If those conditions are met, you can use something like this:
Dim v
Dim sFormula As String
With Selection
sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)
You can adapt this to work round the third limitation by changing the alternate text in the formula string.
Hello :) I was trying to find a way to loop through visible rows in a table without going through all the rows and checking if they are visible as this was consuming too much time on a large table. Below is the solution I was able to come up with. It is a function that returns an array of the absolute row numbers of visible rows in a given Range.
Function GetVisibleRows(LookupRange As Range) As Integer()
Dim VisibleRange As Range, Index As Integer, Area As Range
Static VisibleRows() As Integer
Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
ReDim VisibleRows(0)
Index = 0
For Each Area In VisibleRange.Areas
If Index = 0 Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Index = UBound(VisibleRows())
If VisibleRows(Index - 1) <> Area.Row Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Next
' Remove last empty item
ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
GetVisibleRows = VisibleRows
End Function
If you would like to use this function in a lookup scenario, you need to convert the absolute row numbers returned by the function to relative row numbers of the table. Following worked for me.
RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1
Good luck!
I saw array() = range().value in an example and I'm trying to understand how it works.
Sub test()
Dim arr() As Variant
arr() = Range("E5:E7").Value
For i = 0 To UBound(arr)
Debug.Print arr(i)
Next i
End Sub
First, above code is giving me subscript out of range error. How come ? Second, what part of the documentation would let me know how array() = range().value would play out without testing it ? My hypothesis is that it will go through the cells from the top left to the bottom right and add them to the array. How can I confirm that though ?
I see two issues with your code. The first is that you start i at 0, but arrays in Excel begin at index 1. Instead of For i = 0 you can use For i = LBound(arr) like you use UBound(arr) or just start it at 1.
Second, and more importantly, an array of cells has both columns and rows. When you read a range into a variant array, you get a two-dimensional result (rows and columns) and not a one-dimensional result as you seem to be expecting.
Try this:
Sub test()
Dim arr() As Variant
Dim i As Long, j As Long
arr() = Range("E5:E7").Value
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
Debug.Print arr(i, j)
Next j
Next i
End Sub
If you want to get just the values of the cells into a one dimensional array, you can do that by using the Transpose function, like this:
arr() = Application.WorksheetFunction.Transpose(Range("E5:E7").Value)
If you do this, the array is now one-dimensional and you can iterate through it like you were trying to.
arr() = Application.WorksheetFunction.Transpose(Range("E5:E7").Value)
For i = 1 To UBound(arr)
Debug.Print arr(i)
Next i
This is a good read for you: http://www.cpearson.com/excel/ArraysAndRanges.aspx
The reason you're getting "out of range" is because it returns a 2 dimensional array.
Your line of code For i = 0 To UBound(arr) should be For i = 1 To UBound(arr,1)
Also, the array starts at 1, so don't use the 0 For i = 1 to UBound(arr, 1)
Your corrected code would be:
Sub Test()
Dim arr() as Variant
arr = Range("E5:E7")
For i = 1 To UBound(arr, 1)
MsgBox (arr(i, 1))
Next i
End Sub
It's basically loading the cell values of E5 - E7 into an array. But it is going to be two dimensional. So you will need Debug.Print arr(i, 1)
Sub test()
Dim arr() As Variant
arr() = Range("E5:E7").Value
For i = 1 To UBound(arr)
Debug.Print arr(i, 1)
Next i
End Sub
My sub compares two lists of strings and returns the closest matches. I've found that the sub gets tripped up over some common words such as "the" and "facility". I would like to write a function that would be supplied an array of words to exclude and check each string for these words and exclude them if found.
Here is a sample input:
|aNames | bNames | words to exclude
|thehillcrest |oceanview health| the
|oceanview, the|hillCrest | health
Intended Output:
|aResults |bResuts
|hillcrest |hillcrest
|oceanview |oceanview
So far I have:
Dim ub as Integer
Dim excludeWords() As String
'First grab the words to be excluded
If sheet.Cells(2, 7).Value <> "" Then
For y = 2 To sheet.Range("G:G").End(xlDown).Row
ub = UBound(excludeWords) + 1 'I'm getting a subscript out of range error here..?
ReDim Preserve excludeWords(0 To ub)
excludeWords(ub) = sheet.Cells(y, 7).Value
Next y
End If
Then my comparison function, using a double loop, will compare each string in column A with column B. Before the comparison, the value in column a and b will go through our function which will check for these words to exclude. It's possible that there will be no words to exclude, so the parameter should be optional:
Public Function normalizeString(s As String, ParamArray a() As Variant)
if a(0) then 'How can I check?
for i = 0 to UBound(a)
s = Replace(s, a(i))
next i
end if
normalizeString = Trim(LCase(s))
End Function
There's probably a few parts in this code that won't work. Might you be able to point me in the right direction?
Thank you!
To store the list in the array, you can do this
Sub Sample()
Dim excludeWords As Variant
Dim lRow As Long
With Sheet1 '<~~ Change this to the relevant sheet
'~~> Get last row in Col G
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
excludeWords = .Range("G2:G" & lRow).Value
'Debug.Print UBound(excludeWords)
'For i = LBound(excludeWords) To UBound(excludeWords)
'Debug.Print excludeWords(i, 1)
'Next i
End With
End Sub
And then pass the array to your function. The above array is a 2D array and hence needs to be handled accordingly (see commented section in the code above)
Also like I mentioned in the comments above
How does oceanview, the become Oceanview? You can replace the but that would give you oceanview, (notice the comma) and not Oceanview.
You may have to pass those special characters to Col G in the sheet or you can handle them in your function using a loop. For that you will have to use the ASCII characters. Please see this
Followup from comments
Here is something that I wrote quickly so it is not extensively tested. Is this what you are looking for?
Sub Sample()
Dim excludeWords As Variant
Dim lRow As Long
With Sheet1
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
excludeWords = .Range("G2:G" & lRow).Value
'~~> My column G has the word "habilitation" and "this"
Debug.Print normalizeString("This is rehabilitation", excludeWords)
'~~> Output is "is rehabilitation"
End With
End Sub
Public Function normalizeString(s As String, a As Variant) As String
Dim i As Long, j As Long
Dim tmpAr As Variant
If InStr(1, s, " ") Then
tmpAr = Split(s, " ")
For i = LBound(a) To UBound(a)
For j = LBound(tmpAr) To UBound(tmpAr)
If LCase(Trim(tmpAr(j))) = LCase(Trim(a(i, 1))) Then tmpAr(j) = ""
Next j
Next i
s = Join(tmpAr, " ")
Else
For i = LBound(a) To UBound(a)
If LCase(Trim(s)) = LCase(Trim(a(i, 1))) Then
s = ""
Exit For
End If
Next i
End If
normalizeString = Trim(LCase(s))
End Function
First of all, you cannot call UBound function for the Array that doesn't have a size yet:
Dim excludeWords() As String
ub = UBound(excludeWords) + 1 'there is no size yet
To remove some of the unwanted words use Replace function
String1 = Replace(String1, "the", "")
To do the comparison you described I would use Like function. Here is documentation.
http://msdn.microsoft.com/pl-pl/library/swf8kaxw.aspx