Say I have a large discontiguous range defined, perhaps Range("B:B,E:E,F:F"). How would I go about indexing into the range to treat it as if it were contiguous.
E.g. I'd like to do something like
Set myRange = Range("B:B,E:E,F:F")
v = myRange.ContiguousIndex(5, 3).Value 'retrieves the value in cell F5 (row 5 col 3)
Every method I'm aware of will offset based on the first cell in the range ("B1") and will gladly go out of the bounds of that range, spilling over into the rest of the contents of the workbook. This means that trying to access row 5, col 3 would get you D5, as if columns C and D were in the range I'm trying to index.
I've tried Range.Cells, Range.Offset, and Range.Range, but all seem to exhibit this same spillover.
The other approach I had in mind was to assign the values to a variant array and manually index from there, but this becomes complicated very quickly because a simple snippet like
Dim v() As Variant
v = myRange
will only assign the first area of the discontiguous range into the array, leaving me with an (20^20-1)x1 array and completely ignoring the rest of myRange. So it's probably doable to get the whole myRange into an array if I loop through all the areas and individually assign them into an array I keep reallocating, but it's far from easy and I end up with an array that uses far more memory than I want (unless I put more overhead into trimming it down or I arbitrarily choose a smaller number of rows to copy).
At that point, it would be far more efficient and simple to just loop through the areas manually and do the indexing myself without all the cost of putting things into an array. This final approach is what I'm currently doing.
The Question
Is there any existing method or trick I can use to treat myRange as if it were contiguous in the way I described and to index into myRange in a way that ignores the discontinuities?
TL;DR If I have
Set myRange = Range("B:B,E:E,F:F")
v = myRange.ContiguousIndex(5, 3).Value
I want some method ContiguousIndex to return Range("F5").Value without having to do all the work of manually checking Range.Areas and handling all the indexing.
Bonus Question
Say myRange were Range("E:E,B:B,F:F") (notice the different column order). Is there a nice way to treat E as the first column, B as the second, and F as the third, such that
Set myRange = Range("E:E,B:B,F:F")
v = myRange.ContiguousIndex(5, 2).Value 'retrieves the value in cell B5
returns the value of B5? This is a property of the method I'm using that I'd love to continue having.
Again, the function I have works, but I'm guessing that there's some kind of wonderful method or trick hidden away in all of Excel's quirks that would be even better.
I'm going to post up my own solution in case anyone else runs into a similar problem. This is the only one that worked for me, as the other answers and comments rely on knowing something about the Areas in the range (e.g. relying on each Area being an entire single column, which I couldn't guarantee because my ranges were user-input and could span multiple columns or a finite number of rows).
' Indexes into a discontiguous area as expected, ignoring cells not in Range r
' and treating areas as concatenated (and top-aligned) in the order they are specified
Public Function ContiguousIndex(r As Range, row As Long, col As Long)
Dim area As Range
For Each area In r.Areas
If col <= area.Columns.count Then
If row <= area.Rows.count Then
ContiguousIndex = area.Cells(row, col)
Exit Function
Else
Err.Raise vbObjectError + 9, , "Row Index out of bounds"
End If
Else
col = col - area.Columns.count
End If
Next
' col argument > sum of all cols in all areas
Err.Raise vbObjectError + 9, , "Col Index out of bounds"
End Function
It's worth rementioning something I covered in the comments, but might be unexpected: this code will top-align all areas such that the first row in area 1 is at the same index as the first row in area 2 is the same... etc. This leads to a quirk when calling something like ContiguousIndex(Range("A1:B7,A8:B10"), 9, 2). While it seems obvious this should return B9, this isn't the case - it will actually try to access the 9th row, 2nd column of A1:B7, resulting in an error. That's because the two discontiguous ranges, although they are clearly arranged top-to-bottom on the actual sheet, are treated as if they are side-to-side. So B9 is accessible via the command ContiguousIndex(Range("A1:B7,A8:B10"), 2, 4) (unintuitively). This behavior is what I required, but it might not be what you expect.
In order to circumvent this, you can use the built-in Application.Union or Application.Intersect methods. These automatically collapse contiguous regions when possible. All of the following work:
' Every statement will print "A1:B10" - the areas are merged
' Union of separate areas
Debug.Print Union(Range("A1:B7"), Range("A8:B10")).Address
' Union of range with a known subrange
Debug.Print Union(Range("A1:B7,A8:B10"), Range("A1:B7,A8:B10").Cells(1, 1)).Address
' Union of range with itself
Debug.Print Union(Range("A1:B7,A8:B10"), Range("A1:B7,A8:B10")).Address
' Intersect of range with itself
Debug.Print Intersect(Range("A1:B7,A8:B10"), Range("A1:B7,A8:B10")).Address
If this is the desired behavior when indexing, then perform one of the listed merges before calling ContiguousIndex. Do note that if areas are unmerged in the union operation, their relative discontiguous indices are left unchanged. E.g.
' Yields "A:A,F:F,C:D" not "A:A,C:D,F:F" as you might desire
Debug.Print Union(Range("A:A,F:F,C:C,D:D"), Range("A:A,F:F,C:C,D:D")).Address
Something to note is that with .Cells / .Rows / .Columns / ._Default you can get values outside of your range:
Set myRange = Range("E2:E4,C4:B2,F2:F4") ' C4:B2 gets B2:C4
Debug.Print myRange.Areas(2)(1).Address ' $B$2
Debug.Print myRange.Areas(2)(0, 0).Address ' $A$1
Debug.Print myRange.Areas(2).Cells(0, 0).Address ' $A$1
Debug.Print myRange.Areas(2).Rows(0).Columns(0).Address ' $A$1
If instead you index the values:
Debug.Print myRange.Areas(2).Value2(1, 1) ' value of B2
Debug.Print myRange.Areas(2).Value2(0, 0) ' Run-time error '9': Subscript out of range
If by any chance you have areas with multiple columns like "E:E,A:B" it will be a bit easier to index them if you specify each column as a separate area : "E:E,A:A,B:B"
I think I understand your question a bit better after seeing your example. It can be "simplified" a tiny bit by enumerating the columns instead of the ranges:
Public Function ContiguousIndex(r As Range, row As Long, col As Long) As Range
Dim column As Range
For Each column In r.Columns
If col > 1 Then
col = col - 1
ElseIf col = 1 Then
If row <= column.Rows.Count And row > 0 Then
Set ContiguousIndex = column.Rows(row)
Exit Function
End If
Err.Raise vbObjectError + 9, , "Row Index out of bounds"
ElseIf col < 1 Then
Err.Raise vbObjectError + 9, , "Column Index out of bounds"
End If
Next
End Function
I could not find a way to access the enumerator directly ( for example
r.Columns.[_NewEnum].Item(col) does not work )
Update
Just for example
Public Function veryContiguousIndex(r As Range, row As Long, col As Long) As Range
Dim cell As Range, i As Long: i = col * row
For Each cell In r.Cells
If i = 1 Then Set veryContiguousIndex = cell: Exit Function
i = i - 1
Next
End Function
then
Dim r As Range: Set r = [A1:B7,A8:B10]
Debug.Print r.Cells.Count; r.Columns.Count; r.Rows.Count ' 20 2 7
Debug.Print veryContiguousIndex(r , 9, 2).Address(0, 0) ' B9
Debug.Print veryContiguousIndex(r.EntireColumn, 9, 2).Address(0, 0) ' B9
Debug.Print veryContiguousIndex(r.EntireRow , 9, 2).Address(0, 0) ' R1
How about:
v = myRange.Areas(2).Rows(5).Value 'retrieves the value in cell B5
This appears to work for the both the original and bonus questions as long as each sub-range is a single column. You could also create a simple wrapper function ContiguousIndex(Row,Column) in VBA to give the interface you described.
Hope that helps.
Related
I have an issue I was wondering if anyone could assist me with... I would like to use data type "range" in a similar way to how "collection" works. I would like to use a counter and a loop: "rng(i) = value" where i can be 1, 7, 100 etc. Hence, if I add "A1, A5, C3, D6" to rng, I would like "rng(3)= 3" to set cell C3 equal to 3. Using the "for each x in range" is not an option with regard to how the code are supposed to work. It it possible to make that work?
An alternative solution for me would be if I could add all individual cells in 7 different collections to one variable of data type range.
Any suggestions?
Regards,
Alexander
Unfortunately that would only work if your collection contained a single continuous range.
With a collection of disconnected cells, each cell is its own Area, and trying to directly index the combined Range will give you unexpected results: the index will be applied to the first area, and because it's a single cell area, it will go out of bounds, so e.g. for the range of A1, A5, C3, D6, rng(3) will refer to cell A3 (third cell down relative to A1).
To make indexing work the way you want, you need to mention the Areas property explicitly:
Dim coll As Range
' Set initial contents - has to be at least one cell, can be more
Set coll = some_worksheet.Range("A1,A5,C3")
' This is how you add to already stored "collection"
Set coll = Application.Union(coll, some_worksheet.Range("D6"))
coll.Areas(3) = 42 ' Sets C3 to 42
I'm not sure exactly what you're asking.
Perhaps this is what you're looking for:
MSDN: Looping Through a Range of
Cells
Another easy way to loop through a range is to use a For Each...Next
loop with the collection of cells specified in the Range property.
Visual Basic automatically sets an object variable for the next cell
each time the loop runs. The following procedure loops through the
range A1:D10, setting to 0 (zero) any number whose absolute value is
less than 0.01.
Sub RoundToZero2()
For Each c In Worksheets("Sheet1").Range("A1:D10").Cells
If Abs(c.Value) < 0.01 Then c.Value = 0
Next
End Sub
This works with any ranges, contiguous or otherwise
Sub Test()
Dim rng As Range
Set rng = Sheet1.Range("A1,B5,E7:E9")
Dim v As Variant, a As Range, r As Range
ReDim v(1 To 1)
For Each a In rng.Areas
For Each r In a
v(UBound(v)) = r.Value
ReDim Preserve v(1 To UBound(v) + 1)
Next
Next
ReDim Preserve v(1 To UBound(v) - 1)
Debug.Print v(1)
Debug.Print v(2)
Debug.Print v(3)
End Sub
I want the cell to number itself in an incremental order depending upon the filters. I found the easiest way is to check for the above Row if it is hidden or not then number itself from 1 if hidden and previous cell value+1 if not hidden.
I've tried to achieve this using the Formula
=IF(COUNTA(ADDR)>SUBTOTAL(103, ADDR), 1, ADDR+1)
Where ADDR is defined as follows:
=ADDRESS(ROW()-1,COLUMN(), 4, TRUE)
SUBTOTAL function returns #VALUE as it cannot contain 3-D References.
Tried replacing SUBTOTAL() function with AGGREGATE(), same issue.
Tried to use VALUE() function to convert the ADDR string to value.
I tried to use VBA
Public Function IsHid(i As Integer)
Dim re As Range, x As Integer
Set re = Range("A" & i)
If re.EntireRow.Hidden Then
Set re = Range("A" & i + 1)
re = 1
Else
x = re.Value + 1
Set re = Range("A" & i + 1)
re = x
End If
End Function
The above function returns #VALUE.
The below function also returns #VALUE.
Public Function IsHid(i As Integer)
If Excel.ThisWorkbook.ActiveSheet.Rows(i).Hidden Then
Cells(i + 1, 1).Value = 1
Else
Cells(i + 1, 1).Value = Cells(i, 1).Value + 1
End If
End Function
Very much appreciated if this functionality can be obtained by means of FORMULAS rather than the VBA
Use Subtotal combined with Count(A):
=SUBTOTAL(3,B$2:B2) and paste down.
This can be in column A and will number only visible rows when you filter on B, C, etc.
You might want to take a look here as well, for additional explanation.
Edit:
Let's say you have Sheet1 and you fill up Range A:G. In column A you want the numbering described in the question. Then Range A1 will hold a header (e.g. FilteredID) and Range B:G will hold your other values.
In range A2 all the way down, you put the formula =Subtotal(3, B$2:B2), in Range A3 this will be =Subtotal(3, B$2:B3), in A4 =Subtotal(3, B$2:B4), etc.
Now, when you filter on column B, C, D etc. so you'll have invisible rows, the numbering in column A will show the visible Row number.
For example, assuming you want to start numbering in row 2 and in column A and you have Excel 2010 or later:
=AGGREGATE(4,5,A$1:A1)+1
Just adjust the start cell as required.
I have a worksheet that uses randomly generated numbers in calculations to produce results in two adjacent cells (let's say A1 and A2). I am trying to perform 100 iterations where I'm simply "Calculating Formulas" on the worksheet and then trying to store the results of each iteration next to A1 and A2 (so iteration 1 would be in B1 and B2 and iteration 100 would be in CW1 and CW2). Thanks in advance for your help. Using Excel 2010 if that matters.
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
For i = 1 To Iteration
Calculate
Range("A1:A2").Select
Selection.Copy
Range("B" & Rows.Count).End(x1Up).Offset(0, 1).PasteSpecial
Paste:=xlPasteValues
Next i
End Sub
I think your major problem was with the location you were selecting for the destination address - you were finding the last unused cell in column B, then shifting over one column (i.e. to column C) and pasting the first set of results. Then you were using that same location for the second set of results, etc.
Sub Test()
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
'Use a "With" block so that it can be easily changed in the future
'to refer to a specific sheet if needed
With ActiveSheet
For i = 1 To Iteration
Calculate
'Determine the last used column on row 1,
' offset 1 column to the right,
' resize to refer to 2 rows,
' set values to the values in A1:A2
.Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Resize(2, 1).Value = .Range("A1:A2").Value
Next i
End With
End Sub
As pointed out by Steve Lovell, you also had a typo in your original code. It is a good habit to include Option Explicit as the first line in every code module. That will force you to declare all the variables that you use, and the compiler would have highlighted x1Up and given a "Variable not defined" error.
I'm attempting to use a Scripting Dictionary in a way as to be able to find and ultimately highlight same values or groups of same values where there are inconsistencies (ie blanks or different values in between the two same values or groups of same values). Normally these same values will repeat, but what I'm trying to catch is when they do not repeat together (See example image below taken from my previous post).
Some context that will hopefully help this make a little more sense:
This is a follow-up of sorts to one of my previous questions here. I have a conditional formatting formula:
=NOT(AND(IFERROR(COUNTIF(OFFSET(A1,0,0,-COUNTIF($A$1:$A1,A2)),A2),0)=IFERROR(COUNTIF($A$1:$A1,A2),0),IFERROR(COUNTIF(OFFSET(A3,0,0,COUNTIF($A3:$A$5422,A2)),A2),0)=IFERROR(COUNTIF($A3:$A$5422,A2),0),A2<>""))
Which works perfectly. However, in my tinkering after receiving this formula as the answer to that previous question I realized that using conditional formatting of any sort for the amount of data I typically deal with (15000+ rows with 140 consistent columns) is an extremely slow endeavor, both when applying the formula and when filtering/adjusting afterwards. I've also tried applying this formula via the "helper column" route, but to no surprise, that is just as slow.
So, where I'm at now:
Essentially, I'm trying to translate that formula into a piece of code that does the same thing, but more efficiently, so that's where I starting thinking to use a Scripting Dictionary as a way to speed up my code execution time. I have the steps outlined, so I know what I need to do. However, I feel as though I am executing it wrong, which is why I'm here to ask for assistance. The following is my attempt at using a Scripting Dictionary to accomplish highlighting inconsistencies in Column A (my target column) along with the steps I figured out that I need to do to accomplish the task:
'dump column A into Array
'(Using Scripting.Dictionary) While cycling through check if duplicate
'IF duplicate check to make sure there is the same value either/or/both in the contiguous slot before/after the one being checked
'If not, then save this value (so we can go back and highlight all instances of this value at the end)
'Cycle through all trouble values and highlight all of their instances.
Sub NewandImprovedXIDCheck()
Dim d As Long, str As String, columnA As Variant
Dim dXIDs As Object
Application.ScreenUpdating = False
Set dXIDs = CreateObject("Scripting.Dictionary")
dXIDs.comparemode = vbTextCompare
With ActiveSheet
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'.Value2 is faster than using .Value
columnA = .Columns(1).Value2
For d = LBound(columnA, 1) To UBound(columnA, 1)
str = columnA(d, 1)
If dXIDs.exists(str) Then
'the key exists in the dictionary
'Check if beside its like counterparts
If Not UBound(columnA, 1) Then
If (str <> columnA(d - 1, 1) And str <> columnA(d + 1, 1)) Or str <> columnA(d - 1, 1) Or str <> columnA(d + 1, 1) Then
'append the current row
dXIDs.Item(str) = dXIDs.Item(str) & Chr(44) & "A" & d
End If
End If
Else
'the key does not exist in the dictionary; store the current row
dXIDs.Add Key:=str, Item:="A" & d
End If
Next d
'reuse a variant var to provide row highlighting
Erase columnA
For Each columnA In dXIDs.keys
'if there is more than a single cell address, highlight all
If CBool(InStr(1, dXIDs.Item(columnA), Chr(44))) Then _
.Range(dXIDs.Item(columnA)).Interior.Color = vbRed
Next columnA
End With
End With
End With
dXIDs.RemoveAll: Set dXIDs = Nothing
Application.ScreenUpdating = True
End Sub
I feel like my logic is going wrong somewhere in my code execution, but can't seem to pinpoint where or how to correct it. Any help would be greatly appreciated. If you can provide any sort of code snippet that would also be a great help.
Here's one approach:
Sub HiliteIfGaps()
Dim rng As Range, arr, r As Long, dict As Object, v
Dim num As Long, num2 As Long
Set dict = CreateObject("scripting.dictionary")
With ActiveSheet
Set rng = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
End With
arr = rng.Value
For r = 1 To UBound(arr, 1)
v = arr(r, 1)
If Len(v) > 0 Then
If Not dict.exists(v) Then
num = Application.CountIf(rng, v) 'how many in total?
'all where expected?
num2 = Application.CountIf(rng.Cells(r).Resize(num, 1), v)
dict.Add v, (num2 < num)
End If
If dict(v) Then rng.Cells(r).Interior.Color = vbRed
Else
'highlight blanks
rng.Cells(r).Interior.Color = vbRed
End If
Next r
End Sub
EDIT: every time a new value is found (i.e. not already in the dictionary) then take a count of how many of those values in total there are in the range being checked. If all of those values are contiguous then they should all be found in the range rng.Cells(r).Resize(num, 1): if we find fewer than expected (num2<num) then that means the values are not contiguous so we insert True into the dictionary entry for that value, and start highlighting that value in the column.
#Tim Williams's approach did the job perfectly! I only made one slight alteration (to suit my needs). I changed
.Cells(.Rows.Count, 1).End(xlUp) to .Range("A" & .UsedRange.Rows.count)
Just because there are instances where the bottom-most row(s) might have missing values (be blank) and in this instance I feel safe enough using the .UsedRange reference because this snippet of code is one of the very first ones ran in my overall macro, so it (.UsedRange) is more likely to be accurate. I also added a Boolean operator (xidError, set to False) to be changed to True whenever we have to highlight. After I'm done looping through the Array I check xidError and if True I prompt the user to fix the error, then end the entire macro since there's no use in continuing until this particular error is corrected.
If xidError Then
'Prompt User to fix xid problem
MsgBox ("XID Error. Please fix/remove problematic XIDs and rerun macro.")
'Stop the macro because we can't continue until the xid problem has been sorted out
End
End If
Again, much thanks to Tim for his very efficient approach!
I have a loop wherein I take the mean of several columns of numbers with the same number of rows each.
The point of the loop is to capture these means in a new vector.
So for each loop I need to indicate "all rows". In matlab this would be easy, just use ":" But I can't figure out what the analogy is in VB. Please help! Thanks.
(Please advise me as to what I put in the code below where I have ALLROWS).
My attempt so far:
For i = 1 To CA
mrCA11(i) = Application.WorksheetFunction.Average(revCA11(**ALLROWS**,i))
Next i
In matlab this would be:
For i = 1:CA
mrCA11(i) = mean(revCA11(:,i));
Next i
EDIT: I've also tried this trick to no avail:
For j = 1 To CA
For i = 1 To s11
temp11(i) = revCA11(i, j)
Next i
mrCA11(j) = Application.WorksheetFunction.Average(temp11)
Next j
I get the error message: "Unable to get the Average property of the Worksheet Function class"
As everybody (Tim and shahkalpesh at least) pointed out, we need to understand what is revCall or more specifically, we need to understand how you want to give them ALL ROWS in argument.
Finding the last row (or column or cell)
A common Excel issue is to find the last used row / column / cell.
This will give you the end of your vector.
Excel give you several methods to deal with this:
xlTypeLastCell
Last cell used in the entire sheet (regardless if it's used in column A or not)
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End(xlUp)
Last cell used (including blanks in-between) in Column A is as simple as this:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
End(xlToLeft)
Last cell used (including blanks in-between) in Row 1 is as simple as this:
lastRow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Row
UsedRange
Last cell used in the WorkSheet (according to Excel interpretation):
Set rangeLastCell = ActiveSheet.UsedRange
Using an array as argument
The methods above told you how to find the last row (if this is what you need). You can then easily create your vector and use it in your procedure revCA11.
You can either give an array as argument as Tim pointed out in his answer with this kind of statement:
myArray = ActiveSheet.Range("A1", Cells(lastRow, lastColumn).Value
Or you can use the integer (or long) to build your vector inside your procedure as simple as declaring a range:
Range("A1:A" & lastRow)
You might clarify exactly how revCA11 is declared/created, but maybe something along these lines might work for you:
Sub Tester()
Dim arr, x
arr = ActiveSheet.Range("A1:D5").Value '2-D array
'average each column
Debug.Print "Columns:"
For x = 1 To UBound(arr, 2)
Debug.Print x, Application.Average(Application.Index(arr, 0, x))
Next x
'average each row
Debug.Print "Rows:"
For x = 1 To UBound(arr, 1)
Debug.Print x, Application.Average(Application.Index(arr, x, 0))
Next x
End Sub