Column A contains a list of identical values which are unique among the column. The length of this list is not known. What is the most effienct way to determine the upper and lower bound of the list?
A | B | C | ...
--------------------------
... |
AAA |
AAA |
AAA |
AAA |
AAA |
AAA |
... |
Of course this can be solved by iterating down and up the list from the start postion until you hit a different value. But with larger lists I doubt this is a good solution. Is there any built-in excel function usable in this scenario which would give me a performance advantage?
Other than built in Excel functions as pointed by Scott Craner in comments, you could consider this little VBA function
Function GetArea(rng As Range) As String
With rng.EntireColumn
.AutoFilter field:=1, Criteria1:=rng.Value 'ActiveCell.Value
GetArea= .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas(1).address
.Parent.AutoFilterMode = False
End With
End Function
to be exploited in your "Main" code as follows:
Sub Main()
MsgBox getarea(Range("A12")) '<--| get the bound of the list one element of which is cell A12
End Sub
Here is some sample code you can adapt:
Sub TheOuterLimits()
Dim r As Long, v As Variant
Dim a1 As String, a2 As String
Dim i As Long, c As Long
r = ActiveCell.Row
c = ActiveCell.Column
v = ActiveCell.Value
a1 = ""
a2 = ""
For i = r To 1 Step -1
If Cells(i, c).Value <> v Then
a1 = Cells(i, c).Address(0, 0)
Exit For
End If
Next i
For i = r To Rows.Count
If Cells(i, c).Value <> v Then
a2 = Cells(i, c).Address(0, 0)
Exit For
End If
Next i
MsgBox a1 & vbCrLf & a2
End Sub
The code tells you where the pattern began and where it ends.
Related
I got an excel file with a data source sheet. To be able to parse the data at the next step I need to add 1 to every value and get it into a new sheet. The thing is, that there are multiple values per cell, each separated by comma, and this number is not static. Adding the +1 at a later point is sadly not an option so I need to do this in excel.
Source sheet Prepared data sheet
| MyValues | | MyValues + 1 |
|------------| |--------------|
| 0,1,2,3 | | 1,2,3,4 |
| 3 | -----> | 4 |
| 2,4,6 | | 3,5,7 |
| 1 | | 2 |
Here's helper column based solution. I have assumed data starts from cell A2 and concatenation formula in cell B2. I have considered case of 15 maximum values.
In cell C2, following formula shall be put:
=IFERROR((TRIM(MID(SUBSTITUTE(","&$A2,",",REPT(" ",99)),COLUMNS($A$1:A1)*99,99))/1)+1,"")
This shall be copied across (till column Q) and down (till last row of your data).
Then apply concatenation formula as below in cell B2:
=SUBSTITUTE(TRIM(CONCATENATE(C2," ",D2," ",E2," ",F2," ",G2," ",H2," ",I2," ",J2," ",K2," ",L2," ",M2," ",N2," ",O2," ",P2," ",Q2))," ",",")
shall work for Excel Version 2007 or higher.
Here is one way doing this (assuming Excel 2016 with TEXTJOIN()):
Formula in B1:
=IFERROR(TRIM(MID(SUBSTITUTE($A1,",",REPT(" ",LEN($A1))),(COLUMN()-2)*LEN($A1)+1,LEN($A1)))+1,"")
Drag down and sideways (could be 15 columns if need be)
Formula in G1:
=TEXTJOIN(",",TRUE,B1:E1)
Drag down
You don't need a VBA solution but in your case a UDF could also be a nice way to do this, for example like so:
Function AddVal(RNG As Range, VAL As Double) As String
Dim ARR1() As String, ARR2() As String, X As Double
If RNG.Cells.Count = 1 Then
ARR = Split(RNG.Value, ",")
For X = LBound(ARR) To UBound(ARR)
ReDim Preserve ARR2(X)
ARR2(X) = ARR(X) + VAL
Next X
If IsEmpty(ARR2) Then
AddVal = "No hits"
Else
AddVal = Join(ARR2, ",")
End If
Else
AddVal = "No valid range"
End If
End Function
Call through =AddVal(A1;1)
You can change the 1 for another number if you want to add more than just 1.
I try to create a VBA code (i know that VBA is not tagged) to fulfill this task.
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, Count As Long, j As Long
Dim str As Variant, strNew As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
Count = Len(.Range("A" & i).Value) - Len(Replace(.Range("A" & i).Value, ",", ""))
str = Split(.Range("A" & i).Value, ",")
If Count > 0 Then
For j = 0 To Count
str(j) = str(j) + 1
If .Range("B" & i).Value = "" Then
.Range("B" & i).Value = str(j)
Else
.Range("B" & i).Value = .Range("B" & i).Value & "," & str(j)
End If
Next j
Else
.Range("B" & i).Value = .Range("A" & i).Value + 1
End If
Next i
End With
End Sub
Results:
First, I would like to know if the letter "A" is included in Column A, and secondly if at least one of the occurences has a 1 in Column B.
Column A | Column B
A | 0
B | 1
A | 1
C | 0
A | 0
With my poor skills I can barely know if there is such value in the column.
Set Obj = Sheets("Sheet 1").Range("Column A")
If Not IsError(Application.Match("A", ObjColumn, 0)) Then MsgBox("There is at least one occurrence")
If Application.Vlookup("A", ObjTable, 2, False) = 1 Then MsgBox("At least one A has 1 as value")
Unfortunately, with Application.Vlookup I can only explore first appearance's value.
I have done some research but I have just found excesively complicated codes for such a simple issue.
Thank you in advance!
you could use WorksheetFunction.CountIf() and WorksheetFunction.CountIfs()
Sub main()
With Sheets("Sheet 1") '<--| reference your sheet
If Application.WorksheetFunction.CountIf(.Columns(1), "A") > 0 Then
MsgBox ("There is at least one occurrence")
If Application.WorksheetFunction.CountIfs(.Columns(1), "C", .Columns(2), 1) > 0 Then MsgBox ("At least one A has 1 as value")
End If
End With
End Sub
or, if you have headers on first row, you could use AutoFilter() and Find() methods:
Option Explicit
Sub main()
With Sheets("Sheet 1") '<--| reference your sheet
With Intersect(.Range("A:B"), .UsedRange) '<--| reference its columns A and B used cells
.AutoFilter Field:=1, Criteria1:="A" '<--| filter referenced cells on its 1st column (i.e. column "A") with value "A"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than header
MsgBox ("There is at least one occurrence")
If Not .Resize(.Rows.count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Find(what:=2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then MsgBox ("At least one A has 1 as value") '<--|search 2nd column filtered cells for "1")
End If
End With
End With
End Sub
Thank you #user3598756
Your suggestions helped me to figure out a solution to my needs, as I have a third column which empty would also activate the code.
Column A | Column B | Column C
A | 0 | ""
B | 1 | 0
A | 0 | 1
C | 1 | ""
A | 0 | ""
Below is part of the code:
Set Obj1 = Sheets("Sheet 1").Range("Table[Column A]")
Set Obj2 = Sheets("Sheet 2").Range("Table[Column B]")
Set Obj3 = Sheets("Sheet 3").Range("Table[Column C]")
If Not IsError(Application.Match("A", Obj1, 0)) Then
If Application.CountIfs(Obj1, "A", Obj2, "1") Or Application.CountIfs(Obj1, "A", Obj3, "<>") > 0 Then MsgBox ("At least one occurrence has either an 1 in B or an empty field in C.")
End If
Thanks a lot!
Ok, so here is my simple table, P1-P4 = Product, Ix = Ingredient
+---------------------+
| A B C D |
+---------------------+
| 1 P1 I1 I2 I3 |
| 2 P2 I4 I5 I6 |
| 3 P3 I7 I8 P4 |
| 4 P4 I10 I11 |
+---------------------+
Now what I'm trying to accomplish is, that I can list all Ingredients for example for P3 so I will get a list that looks like that
I7
I8
I10
I11
Is that even possible via a formula in Excel without using VBA?
Thanks in advance
Here is a recursive UDF that does what you want. I do not believe that a formula will do it.
Dim cnt as long
Function viceversa(lkup As Variant, rng As Range, nmbr As Long, Optional rec As Boolean) As String
Dim rngArr
Dim temp as string
If rec = False Then cnt = 1
rngArr = rng.Value
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
If rngArr(i, 1) = lkup Then
For j = LBound(rngArr, 2) + 1 To UBound(rngArr, 2)
If Left(rngArr(i, j), 1) <> "P" Then
If cnt = nmbr Then
viceversa = rngArr(i, j)
Exit Function
Else
cnt = cnt + 1
End If
Else
temp = viceversa(rngArr(i, j), rng, nmbr, True)
If temp <> "" Then
viceversa = temp
Exit Function
End If
End If
Next j
End If
Next i
viceversa = ""
End Function
Put this in in a module attached to the workbook. cnt is a public variable and theDim cnt as Long` needs to be at the top of the module.
Then you can call it like this:
=viceversa($A$3,$A$1:$D$4,1)
$A$3 is the Product, $A$1:$D$4 is the Range including the first column of products. 1 is the first ingredient. I used a helper column with numbers:
It does not matter if you have 1 or more products as ingredients it will continue till all are accounted for.
Note
One thing that will need to change is the test of whether it is a product or not. So change this line If Left(rngArr(i, j), 1) <> "P" Then to something that works to denote that the ingredient being tested is actually a product.
I have an excel set for which I need to count entries based on names. They're all in the same column and there is supposed to be 4 of each entry. I need a formula to count the number of cells with the same entry that do NOT start with either "Retail" or "Commercial" and only return the names in the cells for which there is NOT 4. For example, if my data looks thusly:
NAME
Retail - John
Retail - Sue
Kara
Kara
Joe
Joe
Joe
Joe
Commercial
Sarah
I want a formula that will search this column, and only return "Kara - 2" and "Sarah - 1". The "Retail" and "Commercial" are excluded from the start and since "Joe"=4 I'm not concerned with that. Is there some way I can have this search the column, have it return the first count to meet that criteria to C1, the next one to C2 and so on until I have a column of just the non-compliant entries? I'd love an output like below:
NAME COUNT
Kara 2
Sarah 1
Thanks for looking, I really appreciate any help and advice you can offer!
If your data is in column A the results table will be in columns B & C after running this macro:
Sub MAIN()
Dim A As Range, wf As WorksheetFunction
Dim s1 As String, s2 As String
Dim col As Collection
Set A = Intersect(Range("A:A"), ActiveSheet.UsedRange)
Set wf = Application.WorksheetFunction
Set col = MakeColl(A)
s1 = "Retail"
s2 = "Commercial"
K = 1
For i = 1 To col.Count
v = col.Item(i)
If InStr(v, s1) = 0 And InStr(v, s2) = 0 Then
n = wf.CountIf(A, v)
If n <> 4 Then
Cells(K, "B").Value = v
Cells(K, "C").Value = n
K = K + 1
End If
End If
Next i
End Sub
Public Function MakeColl(rng As Range) As Collection
Set MakeColl = New Collection
Dim r As Range
On Error Resume Next
For Each r In rng
v = r.Value
If v <> "" Then
MakeColl.Add v, CStr(v)
End If
Next r
MsgBox MakeColl.Count
End Function
Since my previous post was closed, but the problem remains, I'll rephrase it here. I've came up with the following:
Function JoinLastInColIfEmpty(range_ As Range, delim_ As String)
Dim cell As Range, result As String, current As String
For Each cell In range_
current = LastNonEmptyInCol(cell)
If current <> "" Then
result = result & current & delim_
End If
Next
If Not IsEmpty(result) Then
result = Left(result, Len(result) - Len(delim_))
End If
JoinLastInColIfEmpty = result
End Function
Function LastNonEmptyInCol(cell_ As Range)
Dim tmp As Range
tmp = cell_ '<< The problem occurs here
Do Until Not IsEmpty(tmp) Or tmp.Row = 1
tmp = tmp.Offset(-1, 0)
Loop
LastNonEmptyInCol = tmp.Value
End Function
The problem is that the function never ends, so my questions are:
What is wrong with my script?
What should I do to solve my problem?
To answer your direct question, there are a couple of errors in LastNonEmptyInCol
Function LastNonEmptyInCol(cell_ As Range)
On Error Resume Next
Dim tmp As Range
Set tmp = cell_ '<< The problem occurs here ' <<<<< use Set
Do Until Not IsEmpty(tmp) Or tmp.Row = 1 ' <<<<< use tmp not cell_
Set tmp = tmp.Offset(-1, 0) ' <<<<< use Set
Loop
LastNonEmptyInCol = tmp.Value
End Function
That said, I think it is a very inefficient solution, and does not quite solve your stated problem
results will be
A | B | C | D | Concat
-----+-----+-----+-----+---------
1 | 2 | X | 5 | 12X5
| | f | 3 | 12f3
| 5 | R | 12 | 15R12
Z | 3 | T | | Z3T12
| G | | | ZGT12
Here's another version which might be better
Function MyJoinLastInColIfEmpty(range_ As Range, delim_ As String)
Dim vData As Variant
Dim cl As Range
Dim i As Long
Dim result As Variant
vData = range_
For i = 1 To UBound(vData, 2)
If vData(1, i) = "" Then
Set cl = range_.Cells(1, i).End(xlUp)
If cl <> "" Then
vData(1, i) = cl.Value
End If
Else
Exit For
End If
Next
For i = 1 To UBound(vData, 2)
result = result & vData(1, i) & delim_
Next
MyJoinLastInColIfEmpty = Left(result, Len(result) - Len(delim_))
End Function
I did not really try to understand the whole thing, but since tmp is an (range) object, you must use
Set tmp = ....
With help rows/columns this can be achieved with formulas:
-Placed in cell F1 array entered (Ctrl+Shift+Enter) then scrolled to however many cells you have:
{=INDEX(A$1:A1,MAX(IF(ISBLANK(A$1:A1),0,ROW(A$1:A1))))}
-Placed in cell K1, refers to first cell in F1, no need for array here.
=IF(ISBLANK(A1),IF(SUM(NOT(ISBLANK(INDEX($A1:A1,0)))+0)>0,"",F1),F1)
-Placed wherever you want the results. MCONCAT is a UDF function found in a free Add-in written in C++, CONCATENATE is Excel's built in formula.
=MConCat(K1:N1) or =CONCATENATE(K1,L1,M1,N1)
My personal preference would be the VBA way though. I'm sure someone smarter than me could come up with some better formulas.