Auto-Numbering depending upon Row or Column being hidden - vba

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.

Related

Finding the cell value 2 columns away dynamically

I wanted to find the cell value 2 columns away. For example, i have found the closest number at A20, the next value i wanted to find will be at C20. Since the closest number may not always fall on A20. How do i code to find the cell.Value 2 columns away dynamically?
The code below is for I find my closest number
ClosestTime2.Value = Application.WorksheetFunction.VLookup(wsInput4.Value, Range("A5:A805"), 1, False)
I did research about it but i found Range.Offset nut suitable for my case.
Since you know the search range ahead of time, you could use Match instead of VLookup. Match returns the relative position of the matching item in the range. You can calculate the row number by adding the row number of the first row of the search range - 1. In this case, since your search range starts on row 5, you would need to add (5 - 1) = 4 to the offset returned by Match to yield the row number.
Offset = Application.WorksheetFunction.Match(wsInput4.Value, Range("A5:A805"), 0)
RowNum = Offset + 4
NextValue = Cells(RowNum, 3).Value
Sub Test()
'Use your sheet code name for below line.
With Sheet3
Dim foundcel As Range
'Use proper data in according to your need.
Dim output As String
'Use below line for your case
'Set foundcel = .Range("A5:A20").Find(what:=wsInput4.Value)
Set foundcel = .Range("A5:A20").Find(what:="Liza")
If Not foundcel Is Nothing Then
output = .Cells(foundcel.Row, foundcel.Column + 2).Value
'In your case use below line
'ClosestTime2.Value=.Cells(foundcel.Row, foundcel.Column + 2).Value
Else
Debug.Print "Data not match"
End If
Debug.Print output
End With
End Sub
Data in sheet
Run output :

Showing Numbers inbetween two numbers on the same row

What I'm trying to achieve is there are 2 whole numbers in column A & B on the same row. I want to fill the row from Column C to show the whole numbers increments of one between the two numbers.
i.e.
A B C D E F G H I J K L
1 10 1 2 3 4 5 6 7 8 9 10
any help would be appreciated.
Assuming this is Excel and you can open the VBE Editor to use VBA
Here's a macro you can run or call via a button
See the comments in the code to understand what it's doing with the Dataseries fill function
Sub FillData()
Dim intStopAt As Integer
' Set to cell indicated low end of range
Cells(1, 1).Select
' Fill in "Start At" Number
ActiveCell.Offset(0, 2).Value = ActiveCell.Value
' Retrieve and use stop number to fill in series
intStopAt = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 2).DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=intStopAt
End Sub
The below code assumes you have no header and that your value in A1 is always 1, and your value in B1 is the number you want to count to.
This can be modified to be more dynamic, but taking your question as is, this should work for you.
1) Check number to count to (CountTo)
2) Run loop for 1 to CountTo and auto-populate your column headers
To run: Open VBE and paste this code on the sheet where you wish to run it.
Sub Counter()
Dim CountTo As Integer
CountTo = Range("B1").Value
For i = 1 To CountTo
Cells(1, i + 2) = i
Next i
End Sub
This can be done without VBA, perhaps not as neat initially as #dbmitch's answer because the formula has to go across to the maximum possible number.
A1 is start number, > 0
B1 is end number (> A1)
In Cell C1 enter =A1
In Cell D1 enter =IF(AND(C1<$B1,C1>=$A1),C1+1,"") and then
drag/fill right as far as you need to.
I have formulated the code so that you can now select the filled rows (A through to wherever) and fill down.
A simple explanation:
C1 sets the start of the list
The AND formula in D1 onwards checks that the immediate left cell (for D1 this is C1, for E1 this is D1 etc.) is less than the end number and greater than the start number.
If the conditions are true, use the immediate left cell value + 1 as the result.
If the conditions are false, insert a blank.
Further checking can be done, I have assumed in the above solution that the numbers are positive and increasing.
You can use helper columns to indicate if you should increase or decrease (i.e. +1 or -1 as required.
Using a blank as the other answer falls down if the numbers go from -ve to +ve. In this case, you could use another symbol (e.g. x) and check for that in the AND function as well.
you could use this:
Sub main()
Dim cell As Range
With Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) ' reference column A cells from row 1 down to last not empty one with a "constant" (i.e. not a formula result) numeric content
For Each cell In .Cells 'loop through referenced range
cell.Offset(, 2).Resize(, cell.Offset(, 1).Value - cell.Value + 1).FormulaR1C1 = "=COLUMN()-COLUMN(C3)+RC1" 'write proper formula in current cell adjacent cells
Next
.CurrentRegion.Value = .CurrentRegion.Value ' get rid of formulas and leave values only
End With
End Sub

Indexing into large discontiguous ranges

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.

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.

VBA - Select columns using numbers?

I'm looking for an alternative to this code, but using numbers.
I want to select 5 columns, the start column is a variable, and then it selects 5 columns from this.
Columns("A:E").Select
How do I use integers instead, to reference columns? Something like below?
For n = 1 to 5
Columns("n : n + 4") .select
do sth
next n
You can use resize like this:
For n = 1 To 5
Columns(n).Resize(, 5).Select
'~~> rest of your code
Next
In any Range Manipulation that you do, always keep at the back of your mind Resize and Offset property.
Columns("A:E").Select
Can be directly replaced by
Columns(1).Resize(, 5).EntireColumn.Select
Where 1 can be replaced by a variable
n = 5
Columns(n).Resize(, n+4).EntireColumn.Select
In my opinion you are best dealing with a block of columns rather than looping through columns n to n + 4 as it is more efficient.
In addition, using select will slow your code down. So instead of selecting your columns and then performing an action on the selection try instead to perform the action directly. Below is an example to change the colour of columns A-E to yellow.
Columns(1).Resize(, 5).EntireColumn.Interior.Color = 65535
you can use range with cells to get the effect you want (but it would be better not to use select if you don't have to)
For n = 1 to 5
range(cells(1,n).entirecolumn,cells(1,n+4).entirecolumn).Select
do sth
next n
Try using the following, where n is your variable and x is your offset (4 in this case):
LEFT(ADDRESS(1,n+x,4),1)
This will return the letter of that column (so for n=1 and x=4, it'll return A+4 = E). You can then use INDIRECT() to reference this, as so:
COLUMNS(INDIRECT(LEFT(ADDRESS(1,n,4),1)&":"&LEFT(ADDRESS(1,n+x,4),1)))
which with n=1, x=4 becomes:
COLUMNS(INDIRECT("A"&":"&"E"))
and so:
COLUMNS(A:E)
In the example code below I use variables just to show how the command could be used for other situations.
FirstCol = 1
LastCol = FirstCol + 5
Range(Columns(FirstCol), Columns(LastCol)).Select
no need for loops or such.. try this..
dim startColumnas integer
dim endColumn as integer
startColumn = 7
endColumn = 24
Range(Cells(, startColumn), Cells(, endColumn)).ColumnWidth = 3.8 ' <~~ whatever width you want to set..*
You can specify addresses as "R1C2" instead of "B2". Under File -> Options -> Formuals -> Workingg with Formulas there is a toggle R1C1 reference style. which can be set, as illustrated below.
I was looking for a similar thing.
My problem was to find the last column based on row 5 and then select 3 columns before including the last column.
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5,Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
Range(Columns(lColumn - 3), Columns(lColumn)).Select
Message box is optional as it is more of a control check. If you want to select the columns after the last column then you simply reverse the range selection
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5,Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
Range(Columns(lColumn), Columns(lColumn + 3)).Select
In this way, you can start to select data even behind column "Z" and select a lot of columns.
Sub SelectColumNums()
Dim xCol1 As Integer, xNumOfCols as integer
xCol1 = 26
xNumOfCols = 17
Range(Columns(xCol1), Columns(xCol1 + xNumOfCols)).Select
End Sub