I've got an Excel spreadsheet with multiple columns of different lengths, each filled with unsorted numbers. Each column has a header.
Is there a way to determine which column(s) contain that number?
For instance, I'd love to be able to do =WHICHCOLS( 123, A, Z ) and have Excel tell me columns [B, C, and K] contain cells with a value of 123. Though, ideally, I'm after a comma separated list of headers.
Equally adequate would be to find all cells, in a range (or ranges), that have that value; e.g. [B19, C32, and K908].
I feel like I'm overlooking some obvious built-in function.
There might be an built-in way to do this but you can also write your own function.
Put this code in a VBA Module:
Public Function WHICHCOLS(searchValue As Double, srcRange As Range) As String
Dim rangeColumn As Range
Dim columnCell As Range
Dim headerRow As Long
headerRow = 1 ' HeaderInformation is in RowNr 1 '
WHICHCOLS = vbNullString
For Each rangeColumn In srcRange.Columns
For Each columnCell In rangeColumn.Cells
If columnCell = searchValue Then
If WHICHCOLS <> vbNullString Then WHICHCOLS = WHICHCOLS & ", "
WHICHCOLS = WHICHCOLS & srcRange.Parent.Cells(headerRow, columnCell.Column)
Exit For
End If
Next columnCell
Next rangeColumn
End Function
An example call in Excel would be:
=WHICHCOLS(7,A2:F3)
Related
am working on sheet and using the vba for the first time and i love it. but been stuck in one thing for the last few days, after all the reading and searching can not figure how to do this part, here is the scenario I have:
locked sheet and workbook, user can only edit/entre values (numbers) in cells C8:G8 and I8:X8, column H always blank and host no value.
the user is able to hide columns in C8:G8 and I8:X8 if he need to use certain number of columns.
trying to set a macro to identify if a value has been entered more then once within the entire range C8:X8 (excluding H it is empty and any other columns if hidden)
I started with countif and give the perfect results only if all columns are visible:
Sub dup()
Application.EnableEvents = False
Dim x As Variant 'tried with range
Dim n As Variant 'tried with range
Dim rng1 As Range 'tried with variant
Set rng1 = Range("C8:X8")
For Each x In rng1.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.CountIf(rng1, x) > 1 Then
x.Offset(4) = "3" 'used for conditional formatting
Else
x.Offset(4) = "10" 'used for conditional formatting
End If
Next
Application.EnableEvents = True
End Sub
still work when some columns are hidden but it does check through hidden columns and this is not what i want (i want it to skip hidden columns)
some search and reading find out the countif is unable to get the cell property if visible or hidden. tried both options application.countif and application.worksheetfunction.countif
so tried application.match but no luck
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.match(x.Value, rng1.Value, 0)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
tried application.hlookup and not able to get the desired result :
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.HLookup(x.Value, rng1.Value, 1, False)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
it will match the cell itself and look only in the first part of the range C8:G8.
just to explain about the hidden columns situation, the user can hide/show 1,2,3,4 and 5 columns in the first range (if user select 2, only columns C8:D8 will be visible) same apply for range I8:X8, if user select 5 only I8:M8 will be visible) so there will be a case where a hidden column will be in between visible columns.
find few answers on how to use SumProduct(subtotal,...) as a formula only and could not covert it to a VBA.
any recommendation and advise will be appreciated.
Please try this solution.
Sub Dup()
Const Sep As String = "|" ' select a character that
' doesn't occur in Rng
Dim Rng As Range
Dim Arr As Variant
Dim SearchString As String
Dim n As Integer
Dim i As Integer
' needed only if you have event procedures in your project:-
Application.EnableEvents = False
Set Rng = Range("C8:X8")
Arr = Rng.Value
SearchString = Sep
For i = 1 To UBound(Arr, 2)
If Not Columns(Rng.Cells(i).Column).Hidden Then
SearchString = SearchString & Arr(1, i) & Sep
End If
Next i
For i = 1 To UBound(Arr, 2)
' skip blanks, incl. column H, & hidden cells
If (Not Columns(Rng.Cells(i).Column).Hidden) And (Len(Arr(1, i)) > 0) Then
n = InStr(SearchString, Sep & Arr(1, i) & Sep)
n = InStr(n + 1, SearchString, Sep & Arr(1, i) & Sep)
With Rng.Cells(i)
If .Column <> 8 Then ' skip column H
.Offset(4).Value = IIf(n > 0, 3, 10)
' Note that "3" is a string (text) whereas 3 is a number
' It's unusual to enter a number as text because it's use
' for calculations is greatly impaired.
' However, you may modify the above line to write strings
' instead of numbers.
End If
End With
End If
Next i
Application.EnableEvents = True
End Sub
The sub assigns all non-hidden values in the Range to to an array and then reads them into a string (SearchString) in which they are separated by a special character which can be re-defined. All values exist in this string at least once. The second loop looks for the existing value which must be both followed and preceded by the special character because "a" would be found in "ab", "a|" in "ba|" but "|a|" is unambiguous. Then a second search (Instr), starting from after where the first match was found, determines if a duplicate exists. The Iif function then sets the value in the cell 4 rows below the examined cell. Note that the array index is identical to the cell number in the range because of the way the array was created.
Since the Instr function will "find" a null string in position 1 and consider it a duplication by default, null strings aren't processed, not setting any number for the purpose of CF. Column H should therefore be omitted. However, if column H should have any value the CF number will still not be written.
As the sub is called by an event procedure the Application's EnableEvents property should be set in that procedure, not in the sub. This is for greater clarity of the code and has no bearing on the functionality unless the vent procedure also calls other procs.
#Variatus, Sorry to get back on this, after further tests i think i found an issue, if i try to hide any clomun from range C8:G8 (ex : G8 and let say it has same value as M8) the Arr will only look through C8:F8 only, for some reason it doesn't go all the way to X8, and it will mark M8 as duplicate.
or even if the duplicate value is withing I8:X8 it wont find it because the Arr stop at the first hidden cell from the first range
any advise will be appreciated
As you can see in the image, there are some 1 and 0s rearranged in 3 rows and one English Alphabet for each column. What I need to do is concatenate the English Alphabets for each row when the respective column value is 0. How can I do it?
Here is a VBA solution that can handle any number of columns (assuming that the letter associated with each column is the standard column label):
Function ZeroColumns(R As Range) As String
Dim n As Long
Dim count As Long
Dim cols As Variant
Dim cell As Range
n = R.Cells.count
ReDim cols(1 To n)
For Each cell In R.Cells
If cell.Value = 0 Then
count = count + 1
cols(count) = Split(cell.Address, "$")(1)
End If
Next cell
ReDim Preserve cols(1 To count)
ZeroColumns = Join(cols, "")
End Function
The code shouldn't be too hard to tweak if the stated assumption doesn't hold.
Conditionally Concatenate Row (UDF)
Arguments
SourceRowRange: The range containing the values that will be
written toCCROW e.g. A, B, C ... Required.
CriteriaRowRange: The range that will be checked for
CriteriaValue. Required.
CriteriaValue: The value that the cells in CriteriaRowRange will
be checked against. Default is 0. Optional.
JoinString: The value that will be put between the values that will
be written to CCROW. Default is "". Optional.
' Copy the following code to a standard module i.e. in VBE go to Insert>Module.
The Code
Function CCROW(ByVal SourceRowRange As Range, ByVal CriteriaRowRange As Range, _
Optional ByVal CriteriaValue As Variant = 0, _
Optional ByVal JoinString As String) As String
Dim vntS As Variant ' Source Array
Dim vntC As Variant ' Criteria Array
Dim NoC As Long ' Number of Columns
Dim j As Long ' Arrays Column Counter
Dim strB As String ' String Builder
Dim strC As String ' Criteria String
' Calculate number of columns of the narrower Range.
NoC = WorksheetFunction.Min(SourceRowRange.Columns.count, _
CriteriaRowRange.Columns.count)
' Copy resized (adjust them to same size) Ranges to Arrays.
vntS = SourceRowRange.Resize(1, NoC)
vntC = CriteriaRowRange.Resize(1, NoC)
' Loop through columns of either Array.
For j = 1 To NoC
' Write current value of Criteria Array to Criteria String.
strC = vntC(1, j)
' Check if Criteria String is NOT empty.
If strC <> "" Then
' Check if Criteria String is equal to Criteria Value.
If strC = CriteriaValue Then
' Check if String Builder is NOT empty.
If strB <> "" Then ' NOT empty.
strB = strB & JoinString & vntS(1, j)
Else ' IS empty (only once).
strB = vntS(1, j)
End If
End If
End If
Next
' Write String Builder to Conditionally Concatenate Row.
CCROW = strB
End Function
Usage in Excel
=CCROW(A$1:I$1,A3:I3) ' Result: ADG
=CCROW(A$1:I$1,A4:I4) ' Result: CFI
=CCROW(A$1:I$1,A5:I5) ' Result: DG
If you add JoinString:
=CCROW(A$1:I$1,A3:I3,,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,", ") ' Result: A, D, G
IF you change CriteriaValue:
=CCROW(A$1:I$1,A3:I3,1) ' Result: BCEFHI
=CCROW(A$1:I$1,A4:I4,1) ' Result: ABDEGH
=CCROW(A$1:I$1,A5:I5,1) ' Result: ABCEFHI
Remarks
Lock ($) the row of SourceRowRange to keep it the same when the formula is copied down.
You can do it all in one formula if you like:
=CONCATENATE(IF($A1=0,'A',''),IF($B1=0,'B',''), ...)
Or put the intermediate strings in a separate row and then concatenate them (to save wear and tear on your fingers).
Are you going to this to many more columns, or just the ones you've mentioned? As long as the number of columns is relatively small, as in your picture, you can concatenate IF functions to achieve your result.
Here's what I did:
Using that formula will get you a result like the one you have:
Assuming also that you have the values in a worksheet like mine, just paste the formula =IF(B3=1,"",B$1)&IF(C3=1,"",C$1)&IF(D3=1,"",D$1)&IF(E3=1,"",E$1)&IF(F3=1,"",F$1)&IF(G3=1,"",G$1)&IF(H3=1,"",H$1)&IF(I3=1,"",I$1)&IF(J3=1,"",J$1)
in B7 and then drag to B8 and B9 to get the rest of the results.
Of course, if you are going to do this for many more columns, it's maybe best to use VBA.
Here, add this function to a module.
You can then call it directly via excel. Nice one.
Function conc(ref As Range, Optional Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In ref
If Cell.Value = 0 Then
Result = Result & chr(64 + Cell.Column) & Separator
End If
Next Cell
If Separator <> "" Then conc = Left(Result, Len(Result) - 1) Else: conc = Result
End Function
The following array formula will do the job (enter it with Ctrl+Shift+Enter):
=CONCAT(IF($A1:$I1=0,UNICHAR(64+COLUMN($A1:$I1)),""))
For older Excel versions, use the legacy functions CONCATENATE() and CHAR() in place of these functions.
If the number is Light-blue Id like to extract the value with the name (column A is the name) to another sheet.
So far I have a working formula that extracts the numerical value. I'm just having trouble extracting the number and name to another sheet, which is the second formula that I have listed. I'd also like to learn what each line of code does.
Anything is appreciated, thanks for your help
Function GetColorNum(prange As Range) As Double
Dim xOut As Double
Dim i As Long
For i = 1 To 100
If prange.Cells.Font.ColorIndex = 33 Then
xOut = prange.Value
End If
Next
GetColorNum = xOut
End Function
Sub tickerextract()
Dim c As Range
Dim ticker As String
If GetColorNum = True Then
Cells(i, 1).EntireRow.Copy
c.offset(0, 1) = ticker
Next c
End Sub
If I understand correctly, it's simpler than originally written.
Option Explicit
Sub TickerExtract()
Dim rngTicker As Range
Set rngTicker = Worksheets("Tickers").Range("B1:B100") 'change as needed, assumes value in column B
Dim rngCel As Range
For Each rngCel In rngTicker
If rngCel.Font.ColorIndex = 33 Then
'change name as needed and column references
Worksheets("Other").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, 2).Value = Array(rngCel.Offset(, -1).Value, rngCel.Value)
End If
Next
End Sub
Try this (arbitrary start column for source range and arbitrary Destination range):
If prange.Cells.Font.ColorIndex=33 Then
Sheets("NAME").Cells(blah, 1).Copy Sheets("NAME2").Cells(moo, rawr)
End If
You would want this within your loop so that each value as it iterates through the cells and copy/pastes if true.
This is some VBA code I've written for Excel. I'm trying to match entries in Sheet1 with those in Sheet2. The structure of both sheets is as follows:
DATE | ID |
----- ----
Date1 ID1
Date2 ID2...
In my code, I loop through the rows of the first sheet, and set the values from each particular row as part of my MATCH() query, in hopes of finding these same values in the second sheet. When I do, I want MATCH() to return the row index it finds these values in, so I can use that same row to input further information from the first sheet. This query uses multiple criteria, as indicated by both the value and searchRange variables (I'm trying to use the multiple criteria via concatenation method, as seen in this article).
The problem is, I consistently get a WorksheetFunction.Match could not be used error. When I used one single criteria (the ID), the function worked. When I tried to use multiple ones, it failed, even though I followed the instructions seen in the previously linked article. Any suggestions or ideas to fix this would be appreciated.
Sub runComparison(Sheet1 As String, Sheet2 As String)
Dim rowCount As Variant, columnCount As Variant, information As Variant
Dim counter As Integer
Dim value As String, searchRange As String
Sheets(Sheet2).Select
'Array of the number of rows in both sheets
rowCount = Array(Sheets(Sheet1).Cells(Rows.count, "A").End(xlUp).row, Sheets(Sheet2).Cells(Rows.count, "A").End(xlUp).row)
'Array of the number of columns in both sheets
columnCount = Array(Sheets(Sheet1).Cells(1, Columns.count).End(xlToLeft).Column, Sheets(Sheet2).Cells(1, Columns.count).End(xlToLeft).Column)
'The range in which we will look for the date and the ID
searchRange = CStr(Range(Cells(2, 1), Cells(rowCount(1), 1)).Address & "&" & Range(Cells(2, 2), Cells(rowCount(1), 2)).Address)
counter = 2
Do Until counter = rowCount(0)
'Sets the search term equal to the current cell in Sheet1
value = Sheets(Sheet1).Cells(counter, 1) & "&" & Sheets(Sheet2).Cells(counter, 2)
' Attempts to set the cell in the 8th column in the same row in which the search term is found equal to a certain value from the search term's row
Cells(WorksheetFunction.Match(value, searchRange, 0), 8) = Sheets(Sheet1).Cells(counter, columnCount(0)).value
counter = counter + 1
Loop
End Sub
Edit: Here's some sample input
value = '7/14/2014&ESTUOUW1046465464'
searchRange = '$A2:$A298&$B2:B298'
UPDATED
Thanks for clarifying in comments. I removed my original answer as it pertains only to the regular "Match" function, and I see the reference/example and understand what you're trying to do now which involves an array formula.
Let's try this using Application.Evaluate which will avoid the need to put this formula in a cell. Using the example data from MS, I did this which seems to work:
Sub test()
Dim value As String
Dim srcRange As String
value = "D2&E2"
srchRange = "$A$2:$A$5&$B$2:$B$5"
Debug.Print Application.Evaluate("=MATCH(" & value & "," & srchRange & ",0)")
End Sub
Applying that in your code, I think would be like below. YOu will still want to Dim matchVal as Variant to hold the result of the formula evaluation, I think. Then do this:
Do Until counter = rowCount(0)
'Sets the search term equal to the current cell in Sheet1
value = Sheets(Sheet1).Cells(counter, 1) & "&" & Sheets(Sheet2).Cells(counter, 2)
'## Assign the result of the Match function to a variable
matchVal = Application.Evaluate("=MATCH(" & value & "," & searchRange & ",0)")
'## Check for errors, and handle as needed:
If IsError(matchVal) Then
'modify as needed, this highlight the cell with the non-matched value
' you might omit this line and simply ignore it, or you could
' display a MsgBox prompt, etc.
Sheets(Sheet1).Cells(counter, columnCount(0)).Interior.ColorIndex = 6
Else:
Cells(matchVal, 8) = Sheets(Sheet1).Cells(counter, columnCount(0)).value
End If
counter = counter + 1
Loop
I'm trying to count the number of unique cells in column C that don't have a "#" or "-" inside.
I have a column of cells that contain names. Some of these names are repeated, and some have characters such as "-" and/or "#" inside - I'm trying to exclude these cells from being counted.
I have 2 formulas that each does half of what I need, but I need to combine the 2 formulas to get the right answer:
This formula counts the number of unique cells (and takes care of blanks): =SUM(IF(COUNTIF(C4:C3689,C4:C3689)=0, "", 1/COUNTIF(C4:C3689,C4:C3689)))
This formula counts the number of cells that don't have a "#" or "-": =SUMPRODUCT(N(LEN(SUBSTITUTE(SUBSTITUTE(C4:C3689,"-",""),"#",""))=LEN(C4:C3689)))
Do you know how to combine the 2 formulas? If you know how to combine the two formulas in a different way (custom function or VBA) that would be great too.
Thanks.
This formula will count the number of different entries in the specified range, excluding any that contain # or -
=SUMPRODUCT((ISERR(SEARCH("#",C4:C3689))*ISERR(SEARCH("-",C4:C3689))*(C4:C3689<>""))/COUNTIF(C4:C3689,C4:C3689&""))
Use a function like this:
=GetUniqueCount("C4:C3689")
Add the function code:
Function GetUniqueCount(rng As Range) As Variant
'Dim rng as Range
'Set rng = Range("C4:C3869") 'Modify as needed
Dim r as Range
Dim uniqueCount as Long
Dim dict as Object
Set dict = CreateObject("Scripting.Dictionary")
For each r in rng.Cells
If Not dict.Exists(r.Value) Then
If Instr(1, r.Value, "#") = 0 Then
If Instr(1, r.Value, "-") = 0 Then
dict(r) = ""
uniqueCount = uniqueCount + 1
End If
End If
End If
Next
GetUniqueCount = uniqueCount
Set dict = Nothing
End Function