I have a column that has text in some cells and formulas in the others. When I'm trying to loop through an array to search for some values in the columns, I can't seem to reference the values as a result of formulas. For example, I'm trying to do conditional statements like If arr(i, 15) = "String" Then but String is the result of a Vlookup.
printing the entire array gives me the formulas, not the results
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = ws.Range("A1").CurrentRegion.Formula
For i = LBound(arr, 1) To UBound(arr, 1)
If Not IsError(arr(i, 15)) Then 'Some of the values are #NA
Debug.Print arr(i, 15)
End If
Next i
End Sub
If you only want to obtain value from cells formula not result in error, probably array may not suitable in such case, use For loop will achieve your expected input also. In my example, Range("E3) is not printed due to error, you can combine with lastrow for dynamic range:
I add version 2 here for using array looping, the outcome skip to print Range("E2") due to error, hope it help :)
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Dim i As Long
Dim textValue As String
Set ws = ThisWorkbook.Worksheets("Sheet2")
arr = ws.Range("D1").CurrentRegion.Value
For i = LBound(arr) To UBound(arr)
textValue = CStr(arr(i, 2))
If InStr(textValue, "Error") <= 0 Then 'Some of the values are #NA
Debug.Print textValue
End If
Next i
End Sub
your code has an End If without if
To get the value of the formula, use Evaluate(formula), this line only work if send a formula as parameter, use on error resume next if is possible to sent errors, empty values or not formula values... Good Luck
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = ws.Range("A1").CurrentRegion.Formula
For i = LBound(arr, 1) To UBound(arr, 1)
On Error Resume Next
If Not IsError(arr(i, 15)) Then 'Some of the values are #
Debug.Print Evaluate(arr(i, 15))
'End If
End If
Next I
End Sub
Related
I have my column B, starting from cell 2 (because of the header) containing codes of type String. I would like to get a list of these codes. However, these codes are repeated a number of times. So I would like to loop through my column B and add to my array of codes whenever a new one is encountered, if that makes sense.
Here is my code. How can this be done ? Thanks in advance.
Sub List()
Dim listCodes() As String
With Worksheets("My sheet)
nbr_lines = .Rows.Count
Dim i As Long
val_old = .Cells(2, 2).Value
listCodes(1) = val_old
For i = 2 To nbr_lines
val_new = .Cells(i + 1, 2).Value
While val_old = val_new
val_old = val_new
Wend
listCodes(i) = val_new
val_old = val_new
Next i
End With
End Sub
As mentioned in my comment, I'd suggest a dictionary. Drop the entire column into an array for speedy processing first, then throw it all in the dictionary:
Sub List()
Dim listCodes() As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim nbr_lines As Long
With Worksheets("My sheet")
'Get last used line and throw values in array;
nbr_lines = .Cells(.Rows.Count, 2).End(xlUp).Row
listCodes = .Range("B2:B" & nbr_lines).Value
'Loop array instead of cells for speed. Add all unique items into dictionary;
For Each el In listCodes
dict(el) = ""
Next
'Add the content of the dictionary to the sheet;
.Range("C2").Resize(dict.Count).Value = Application.Transpose(dict.Keys)
End With
End Sub
Note: This can also be achieved outside of VBA through easy formulae like the UNIQUE() function.
You can use dictionary approach. Below sub will copy only unique items to column D. Modify codes as your need.
Public Sub CopyUniqueOnly()
Dim i As Long
Dim currCell As Range, dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Worksheets("Sheet1")
For Each currCell In .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))
If Not dict.exists(currCell.Value) And Not IsEmpty(currCell) Then
dict.Add currCell.Value, currCell.Value
End If
Next currCell
End With
Range("D2").Resize(dict.Count) = Application.Transpose(dict.keys)
End Sub
l am trying to collect and SUM data from a workbook.
The data I need is calculated from cells in one sheet of the workbook. I will display the result with "value only format".
How can I shorten the code and make it run faster?
The workbook where I collect data is Test.xlsm and I have around 30 items.
Sub Test1()
'
' Test1 Macro
Dim Slaw150 As Variant
Dim Slaw200 As Variant
Dim Slaw300 As Variant
Dim Slaw400 As Variant
Slaw150 = "=SUM('[Test.xlsm]Test'!$CO$66:$CS$66,'[Test.xlsm]Test'!$CO$88:$CS$88,'[Test.xlsm]Test'!$CO$95:$CS$95)"
Slaw200 = "=SUM('[Test.xlsm]Test'!$CO$67:$CS$67,'[Test.xlsm]Test'!$CO$89:$CS$89,'[Test.xlsm]Test'!$CO$96:$CS$96)"
Slaw300 = "=SUM('[Test.xlsm]Test'!$CO$68:$CS$68,'[Test.xlsm]Test'!$CO$90:$CS$90,'[Test.xlsm]Test'!$CO$97:$CS$97)"
Slaw400 = "=SUM('[Test.xlsm]Test'!$CO$69:$CS$69,'[Test.xlsm]Test'!$CO$91:$CS$91,'[Test.xlsm]Test'!$CO$98:$CS$98)"
With Range("C42")
.Value = Slaw150
.Value = .Value
End With
With Range("C43")
.Value = Slaw200
.Value = .Value
End With
With Range("C44")
.Value = Slaw300
.Value = .Value
End With
End Sub
Please, test the next way:
Sub TestSUMM()
Dim sh As Worksheet, rngSUM As Range, arrSUM, i As Long
Set sh = Workbooks("Test.xlsm").Sheets("Test")
Set rngSUM = sh.Range("CO66:CS69,CO88:CS91,CO95:CS98") 'The whole discontinuous range
ReDim arrSUM(1 To 4, 1 To 1) 'ReDim the array to keep processing result
For i = 1 To rngSUM.rows.Count 'iterate between the discontinuous range rows and summarize them:
arrSUM(i, 1) = WorksheetFunction.Sum(rngSUM.rows(i))
Next i
sh.Range("I41").Resize(4).Value = arrSUM 'drop the array content at once
End Sub
I want to remove the left character from a column of strings without looping over each cell, but I'm getting an error in Excel. Here is my code, can I do this without a for loop?
Public Sub TestRngAdjust()
Dim TestRNG As Range
Set TestRNG = Range("A1:A5")
TestRNG.NumberFormat = "#"
TestRNG.Value = Right(TestRNG.Value, Len(TestRNG.Value) - 1)
End Sub
If you don't want to loop:
Dim s As String
s = "RIGHT(" & TestRNG.Address & ",LEN(" & TestRNG.Address & ") - 1)"
TestRNG.Value = TestRNG.Parent.Evaluate(s)
But really, it's very easy to read the data into a Variant array, use Right on each element, then write the array back to the range.
Loops are not bad. They are bad when looping ranges on worksheets.
Use variant arrays to loop.
Using Variant method:
load range into a variant array.
loop the array and make changes.
assign variant array data back to range.
Public Sub TestRngAdjust()
Dim TestRNG As Range
Set TestRNG = Range("A1:A5")
Dim rngarr As Variant
rngarr = TestRNG.Value
Dim i As Long
For i = 1 To UBound(rngarr, 1)
rngarr(i, 1) = Mid$(rngarr(i, 1), 2)
Next i
TestRNG.NumberFormat = "#"
TestRNG.Value = rngarr
End Sub
I thought this would be simple, but apparently the geniuses at Microsoft think differently.
I am writing Excel VBA to loop through the rows in an Excel worksheet and for each row (a Range object), I want to extract the cell values as an array. I've done some searching and found some supposed solutions that are not at all intuitive, nor do they work.
Does anyone have suggestions on how to do this?
Private Sub Separate_By_DC()
Dim row_ As Range
Dim row_str As String
For Each row_ In ActiveSheet.UsedRange.Rows
Dim arr As Variant
arr = Row_To_Array(row_)
Debug.Print UBound(arr) - LBound(arr) + 1
' row_str = Concat_Row(row_)
' Debug.Print row_str
Next row_
End Sub
Private Function Row_To_Array(row_ As Range) As Variant
Row_To_Array = row_.Value
End Function
Think the most easiest way would be:
Sub test()
Dim mArr As Variant
Dim i As Long
mArr = Application.Transpose(Range("A1:A10")) 'Transpoose to make the array one dimensional
'loop through the array
For i = LBound(mArr, 1) To UBound(mArr, 1) 'For one dimensional you can remove ",1"
'do something with mArr value
Cells(i, "C").Value = mArr(i) 'Print the array value
Next i
End Sub
For 2 dimensional array you can loop through it by state the dimensional index:
Dim mArr As Variant
Dim i As Long
mArr = Range("A1:A10") 'Use 2 dimension
'loop through the array
For i = LBound(mArr, 1) To UBound(mArr, 1)
'do something with mArr value
Cells(i, "C").Value = mArr(i, 1)
Next i
I know a lot of threads regarding this topic already exist, but I still can't find a solution that works in this scenario. The following two subs keep giving me a "subscript out of range" error.
Sub test1()
Dim Arr() As Variant
Arr= Range("A1:A10")
MsgBox Arr(0)
End Sub
Sub test1()
Dim Arr As Variant
Arr= Range("A1:A10").Value
MsgBox Arr(0)
End Sub
EDITED for clarity, in light of the comments below.
Assigning a range's Value to a Variant variable will either result in the variable containing a one-based 2D array of Variants indexed by row and column (in this order), or containing the actual value of the range if it's a 1-cell range.
In your particular case, this would work:
Sub test1()
Dim Arr As Variant
Dim row As Long
Dim col As Long
row = 1
col = 1
Arr = Range("A1:A10").Value
MsgBox Arr(row, col)
End Sub
In a more general approach, if your downstream code expects to deal with an array, but you range has the possibility to cover a single cell, you can force an array even in such a situation, along those lines:
Sub test2()
Dim rng As Range
Dim Arr As Variant
Dim row As Integer
Dim col As Integer
row = 1
col = 1
Set rng = Range("A1:A1") '<== 1 cell only!
Arr = rng.Value
'Ensure we're dealing with an array even in this case.
If Not IsArray(Arr) Then
ReDim Arr(1 To 1, 1 To 1) As Variant
Arr(1, 1) = rng.Value
End If
MsgBox Arr(row, col)
End Sub