Is it possible to combine a string and a variable to create a name of another variable and referencing it in the same go? Like this:
Sub Test()
Dim colorName As String
Dim columnYellow As Long
colorName = "Yellow"
columnYellow = 3
Debug.Print columnYellow '-> prints "3"
Debug.Print "column" & colorName '-> prints "columnYellow" (I would like it to return 3)
End Sub
I would want Debug.Print "column" & colorName to return "3" instead of "columnYellow". Ho can I do that?
Variable identifiers can't be concated, except with CallByName what is limited to objects (you can't call a method from a standard module).
As alternative use an array or a collection. You have to use the collection, where you can have a string as key to a value and strings can be concated.
Sub Test()
Dim ColorNameNr As Collection
Dim colorName As String
Set ColorNameNr = New Collection
ColorNameNr.Add 3, "columnYellow"
colorName = "Yellow"
Debug.Print ColorNameNr.Item("columnYellow") '-> prints "3"
Debug.Print ColorNameNr.Item("column" & colorName) '-> prints "3")
End Sub
Might this code help? Enter either a valid index number or a word for a listed colour.
Function ColIndex(ByVal Arg As Variant) As Variant
' return 0 if not found
' first colour listed has the index #1
Const Cols As String = "Red,Green,Yellow"
Dim Col() As String
Dim i As Integer
Select Case VarType(Arg)
Case vbString
Col = Split(Cols, ",")
For i = UBound(Col) To 0 Step -1
' use VbBinaryCompare for case sensitive comparison
If StrComp(Col(i), Arg, vbTextCompare) = 0 Then Exit For
Next i
If i >= 0 Then ColIndex = i + 1
Case vbInteger, vbLong
On Error Resume Next
ColIndex = Split(Cols, ",")(Arg - 1)
End Select
End Function
Could we use an array?
Sub Test()
Dim colors(0 To 1, 0 To 1) as Variant
colors(0, 1) = "Yellow"
colors(1, 0) = 3
Debug.Print "Column " & colors(1, 0) 'prints column number
Debug.Print "Color " & colors(0, 1) 'prints color name
End Sub
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 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.
So I have an application where I'm looking up data from a bunch of different tables and entering the data into a bunch of variables to be used elsewhere. I wrote a function to look up and return a row (as a Range) from a specified table given an entry in the first column:
Public Function RowLookup(table As Range, entry As String) As Variant
Dim rowNum As Variant
rowNum = Application.Match(entry, table.Columns.item(1), 0)
If IsError(rowNum) Then
RowLookup = CVErr(xlErrValue)
Else
RowLookup = table.Rows(rowNum)(1)
End If
End Function
However, now I've ended up with a ton of code that looks like this:
tempRow = RowLookup(Range("Table1"), var1)
If IsError(tempRow) Then
var2 = ""
var3 = ""
var4 = ""
var5 = ""
Debug.Print "Error looking up data"
Else
var2 = tempRow(1, 2)
var3 = tempRow(1, 3)
var4 = tempRow(1, 4)
var5 = tempRow(1, 6)
End If
Any ideas on how to work this boilerplate code into the function? I want it to take an arbitrarily long list of (colIndex, variable) pairs and then set each variable based on columnIndex. Using a Collection doesn't seem to work as I can only change the entry in the Collection, not the original variable.
You could pass the Vars and Table Index's as a ParamArray
I'd rework RowLookup as a Sub. Param Arrayexpects pairs of Variables, and Table Column Numbers.
An Odd number of passed parameters cauase an error.
A Column Index > number of columns in Table is ignored
Vars don't have to be Variants (they will be type cast, so could throw errors)
Public Sub RowLookup(table As Range, entry As Variant, ParamArray Vars() As Variant)
Dim rowNum As Variant
Dim i As Long
Dim TableData As Variant
Dim TableColumns As Long
If WorksheetFunction.IsEven(UBound(Vars)) Then
For i = 0 To UBound(Vars) - 1 Step 2
Vars(i) = CVErr(xlErrNA)
Next
Else
rowNum = Application.Match(entry, table.Columns(1), 0)
If IsError(rowNum) Then
For i = 0 To UBound(Vars) - 1 Step 2
Vars(i) = CVErr(xlErrValue)
Next
Else
TableData = table.Value
TableColumns = UBound(TableData, 2)
For i = 0 To UBound(Vars) - 1 Step 2
If Vars(i + 1) >= 1 And Vars(i + 1) <= TableColumns Then
Vars(i) = TableData(rowNum, Vars(i + 1))
End If
Next
End If
End If
End Sub
and call it like this
Sub Demo()
Dim SomeLongVar As Long
Dim SomeStringVar As String
Dim var3(1 To 2) As Variant
Dim var4 As Variant
Dim var5 As Variant
var3(2) = 5 ' Column Index
RowLookup Range("Table1"), "x", SomeLongVar, 2, SomeStringVar, 3, var3(1), var3(2)
Debug.Print SomeLongVar, SomeStringVar, var3(1)
End Sub
My vba code should organiza a balance sheet I just pasted o Excel from a PDF. So, like most balance sheets, there are the description of the item (asset/liabilities/etc) and the values from the years that are being analyzed.
First, I was trying to identify in which position the text ended. So I wrote the following code, which is giving me and error (Invalid Qualifier).
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
subjectCell = ActiveCell.Value
For i = 0 To Len(subjectCell) - 1
If (letters.Contains(Mid(subjectCell, i + 1, 1))) Then
Else
index = i
Next i
Cell("A1").Value = index
Sub test()
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
subjectCell = ActiveCell.Value2
For i = 1 To Len(subjectCell)
If InStr(1, letters, Mid(subjectCell, i, 1), vbTextCompare) = 0 Then
index = i
Exit For
End If
Next i
Range("A1").Value2 = index
End Sub
There are a few problems here
No end if for your if statement
Your cell should be range if you're defining a range like A1, cells is for 1, 1 type reference
Using ActiveCell is poor form, define it explicitly
Using Range("A1").Value is better but also poor form, fully define it like workbooks("book1.xlsx").sheets("Sheet1").Range("A1").Value
You cant use the letters.function( type in vba, I've illustrated instr (or in string) to show how this can work to a similar effect.
I've changed your code to better illustrate what it maybe should look like:
Sub g()
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
'subjectCell = ActiveCell.Value
subjectCell = "a"
For i = 0 To Len(subjectCell) - 1
If InStr(letters, subjectCell) > 0 Then
Debug.Print "Found it! It starts at position: " & InStr(letters, subjectCell)
Else
Debug.Print "No Match"
index = i
End If
Next i
Range("A1").Value = index
End Sub
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!