I'd like to find if any row in Column C matches any cells in Column A or B and print out 'yes' or 'no' in an adjacent cell if it does match. The match might not be exact, because an ID may be written as '12401' but the match in the column may be like 'cf[12401]', with the ID enclosed in brackets.
This is an example of what I might find in the table. The values in A and B columns originally came from another table but I'm trying to find all instances of where they might exist in the third column.
Excel Example:
If possible, I'd like to list the values themselves that matched in the column. But that part would be a nice extra while the other part is more important because there are around 6000 values in the middle column so it would take days by hand.
I've tried different things like this:
=IF(COUNTIF(C2,"*" & A6 & "*" ), "Yes", "No")
or
=IF(COUNTIF(C2,"*" & Length & "*" ), "Yes", "No")
these work for individual words or cells, but trying to check all the values in that column against the cell will return no. I've tried variations of SUMPRODUCT and others that I've found, but haven't been able to get something that works for multiple values.
Is there some function in Excel that will allow me to do this? Or maybe a way in VBA?
Here is some UDF you could use.
Dim MyArr As Variant, X As Double, LR As Double
Option Explicit
Public Function MatchID(RNG As Range) As String
With ActiveWorkbook.Sheets(RNG.Parent.Name)
LR = .Cells(Rows.Count, 1).End(xlUp).Row
MyArr = Application.Transpose(.Range(.Cells(2, 1), .Cells(LR, 1)))
For X = LBound(MyArr) To UBound(MyArr)
If InStr(1, RNG.Value, MyArr(X), vbTextCompare) > 0 Then
If MatchID = "" Then
MatchID = MyArr(X)
Else
MatchID = MatchID & ", " & MyArr(X)
End If
End If
Next X
End With
End Function
Public Function MatchCFNAME(RNG As Range) As String
With ActiveWorkbook.Sheets(RNG.Parent.Name)
LR = .Cells(Rows.Count, 1).End(xlUp).Row
MyArr = Application.Transpose(.Range(.Cells(2, 2), .Cells(LR, 2)))
For X = LBound(MyArr) To UBound(MyArr)
If InStr(1, RNG.Value, MyArr(X), vbTextCompare) > 0 Then
If MatchCFNAME = "" Then
MatchCFNAME = MyArr(X)
Else
MatchCFNAME = MatchCFNAME & ", " & MyArr(X)
End If
End If
Next X
End With
End Function
In D2 Ijust used =IF(F2<>"","YES","") and dragged it sideways and down.
Related
How do I return a result from a function?
For example:vba: i want function
Function xy2cell(i, f)
xy2cell = "=" & "?????????????????????????????"
End Function
Sub aaa_main()
ActiveSheet.Cells.Clear
f = "5^4*x-2^4*y-1"
For i = 1 To 2
Cells(i, 3) = xy2cell(i, f)
Next
End Sub
'I want
'Cells(1, 3) = "=5^4*" & Cells(1, 1).Address & "-2^4*" & Cells(1, 2).Address & "-1"
'Cells(2, 3) = "=5^4*" & Cells(2, 1).Address & "-2^4*" & Cells(2, 2).Address & "-1"
(20220328)
original
Japanese below ↓↓↓↓↓↓-------------------------------------------
2022 Mathematics 1A Q4 < The Common Test for University Admissions is a common entrance examination for Japanese universities
https://cdn.mainichi.jp/item/jp/etc/kyotsu-2022/pdf/MTAP.pdf#page=20
I try (vba & vba solver)
https://qiita.com/mrrclb48z/items/af08059157cfbce8f0fe
Japanese up ↑↑↑↑↑-------------------------------------------
A simpler approach is to use the formual2R1C1 property of a range. This allows you to specify a formula using notation that refers to cells as offsets from the destination cell. This way, a single expression can be used to create different formulas in each target cell of the range.
Sub aaa_main_2()
Dim f As String
f = "=5^4*x-2^4*y-1"
f = Replace(f, "x", "RC[-2]")
f = Replace(f, "y", "RC[-1]")
ActiveSheet.Cells.Clear
Range("C1:C2").Formula2R1C1 = f
End Sub
or, more directly
Sub aaa_main_3()
ActiveSheet.Cells.Clear
Range("C1:C2").Formula2R1C1 = "=5^4*RC[-2]-2^4*RC[-1]-1"
End Sub
It seems unusual to clear all the cells from the active sheet, as this would remove any inputs on which the function would operate. Nonetheless, here is your code converted to do as you ask. I've added Dim statements to declare the variables your code uses.
Function xy2cell(i As Long, f As String)
Dim formula As String
formula = Replace(f, "x", Cells(i, 1).Address(False, False))
formula = Replace(formula, "y", Cells(i, 2).Address(False, False))
xy2cell = "=" & formula
End Function
Sub aaa_main()
Dim f As String
Dim i As Long
ActiveSheet.Cells.Clear
f = "5^4*x-2^4*y-1"
For i = 1 To 2
Cells(i, 3).Formula = xy2cell(i, f)
Next
End Sub
This code uses the "replace" function to find "x" in your formula string (f) and replace it with the appropriate cell reference. The result is stored in a variable named "formula" which is then used as the input to replace y with the appropriate cell reference.
However, there is a much simpler approach using the formula2R1C1 property. I'll post a separate solution on that technique.
As part of a larger process I need to create a Excel VBA Macro that read the values from a column and applies basic formatting to the row based on the values in each cell.
The spreadsheet itself is exported from another program and opens directly in Excel. All columns come across formatted as General
The sequence is this:
Start at the second row in Sheet1
Look at Column J
Read the RGB value (which is shown as RGB(X,Y,Z) where X, Y, and Z are the numerical values for the color that needs to be used)
Change that rows text Color for Column A-I to that color
Continue through all rows with text
I found this thread, but I'm not able to make it work.
Any help here much appreciated.
Sub ColorIt()
Set cl = Cells(2, "J")
Do Until cl = ""
txt = cl.Value2
cl.Offset(, -9).Resize(, 9).Font.Color = _
Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
Set cl = cl.Offset(1)
Loop
End Sub
Result:
Edit2
Sub ColorIt2()
Const RGB_COL = "M"
Set cl = Cells(2, RGB_COL)
Do Until cl = ""
txt = cl.Value2
cl.Offset(, 1 - cl.Column).Resize(, cl.Column - 1).Interior.Color = _
Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
Set cl = cl.Offset(1)
Loop
End Sub
Please, use the next function. It will convert the string in a Long color (based on the RGB three parameters. It will work for both caser of comma separators ("," and ", "):
Function ExtractRGB(strRGB As String) As Long
Dim arr: arr = Split(Replace(strRGB, " ", ""), ",")
ExtractRGB = RGB(CLng(Right(arr(0), Len(arr(0)) - 4)), CLng(arr(1)), CLng(left(arr(2), Len(arr(2)) - 1)))
End Function
It can be tested in the next way:
Sub TestExtractRGB()
Dim x As String, color As Long
x = "RGB(100,10,255)"
x = "RGB(100, 10, 255)"
color = ExtractRGB(x)
Debug.Print color
Worksheet("Sheet1").Range("A2:I2").Font.color = color
'or directly:
Worksheet("Sheet1").Range("A2:I2").Font.color = _
ExtractRGB(Worksheet("Sheet1").Range("J2").value)
End Sub
If you comment x = "RGB(100, 10, 255)", it will return the same color valuem for the previous x string...
If you need to do it for all existing rows, the code must iterate from 2 to last Row and you only need to change "A2:I2" with "A" & i & ":I" & i
If necessary, I can show you how to deal with it, but I think is very simple...
I need to split cells into multiple rows without moving the cells in the ID column. The problem is that the list can be endless and the number of category's can be different and alose their can be information in column C which also have to stay on the same line as the ID cell.
Current and wanted results
https://imgur.com/a/rslXx4A
You could use a macro to loop through your info and print it in the new columns. Something like:
Sub delimit()
Dim cat As Range, c As Range, i As Long, nxt As Long
Set cat = ActiveSheet.Range(Range("B2"), Range("B65000").End(xlUp))
For Each c In cat
arr = Split(c.Value, ";")
For i = 0 To UBound(arr)
nxt = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
Range("E" & nxt).Value = arr(i)
Next i
Next c
End Sub
The core thing we are using here is Split() which will turn a string into an array.
Syntax : Split ( expression [,delimiter] [,limit] [,compare] )
We loop through the category list, set to column "B", and make a new array for each cell.
Then we print this array in the column we want, in this example column "E".
But first, we print out the ID number in column "D", since we are currently aiming for that row.
If you also want to copy column "C" like we do "A", simply change the IF accordingly.
From
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
to
If i = 0 Then
Range("D" & nxt).Value = c.Offset(0, -1)
Range("F" & nxt).Value = c.Offset(0, 1)
End If
image worksheetI am setting up sheet with hotels details and column "D" has hospitals that are close by eg PMH,SCGH,FSH. What i am trying to do is search column "D" based on a cell value on same sheet. I have code below but it will only do what i want if the cells in column"D" are single entry eg pmh. I need to be able to search all the cells in Column "D" for any instance of the text.
Many Thanks for any assistance
`Option Explicit
Sub finddata()
Dim hospitalname As String
Dim finalrow As Integer
Dim i As Integer
Sheets("Results").Range("A4:D100").ClearContents
Sheets("Main").Select
hospitalname = Sheets("Main").Range("g3").Value
finalrow = Sheets("Main").Range("A1000").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 4) = hospitalname Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Sheets("Results").Range("A4").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Main").Range("g3").Select
End Sub
`
The two simplest ways to do this would be
Using the Like operator:
If Cells(i, 4).Value Like "*" & hospitalname & "*" Then
This method has the drawback that a hospital name of, for instance, PMH might be matched against another one such as SPMH.
Using the InStr function:
If Instr("," & Cells(i, 4).Value & ",", "," & hospitalname & ",") > 0 Then
In this line, I "wrap" both the cell being looked at, and the value being searched for, within commas so it ends up searching for the string (for instance) ",PMH," within the string ",PMH,SCGH,FSH,". InStr will return the character position at which a match occurs, or zero if no match is found. So testing for > 0 is testing whether a match occurred.
I am new to both VBA and stackoverflow. So please be patient ;).
I searched for a solution but could not find it.
My problem is as follows:
I have a column (A) with names and then a column (B) where some cells contain an "X" and others do not. I want to know which names have an "X" besides them.
Example:
I want now a string as a result, in one cell.
In this example:
Noah;Jacob;Elijah;Jayden
I got not very far.
For r = 1 To 20
If Cells(r, 2) = "X" Then A = Cells(r, 1) Else
Next
Then "A" is "Noah" and I can write it in a cell, but I want it to find all values and then write them combined, preferable seperated by ; in a cell.
Does anyone have any idea?
Create a string variable, then append your results to that variable based on "X" being in column B. Here's an example of how you could do it:
Sub Foo()
Dim i As Integer
Dim result As String
For i = 1 To 20
If UCase(Cells(i, 2).Value) = "X" Then
result = result & Cells(i, 1).Value & ";"
End If
Next
'// output the result to C1
Range("C1").Value = Left$(result, Len(result) - 1)
End Sub
Excel's native worksheet formulas do not handle concatenating an unknown number of strings together and compensating for the maximum number possible can get messy. A User Defined Function¹ (aka UDF) takes advantage of VBA's ability to process loops through a large number of rows while making numerical or string comparisons 'on-the-fly'.
build_List UDF
Function build_List(rNAMs As Range, rEXs As Range, vEX As Variant, _
Optional delim As String = ";", _
Optional bCS As Boolean = False)
Dim str As String, rw As Long, cl As Long
With rNAMs.Parent
Set rNAMs = Intersect(.UsedRange, rNAMs)
Set rEXs = .Cells(rEXs.Rows(1).Row, rEXs.Columns(1).Column). _
Resize(rNAMs.Rows.Count, rNAMs.Columns.Count)
End With
With rNAMs
For rw = .Rows(1).Row To .Rows(.Rows.Count).Row
For cl = .Columns(1).Row To .Columns(.Columns.Count).Row
If (.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl) = vEX And bCS) Or _
(LCase(.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl)) = LCase(vEX)) Then _
str = str & .Cells(rw, cl).Value & delim
Next cl
Next rw
End With
build_List = Left(str, Len(str) - Len(delim))
End Function
In D7 (as per image below) as,
=build_List(A:A, B:B, "x")
Applying the build_Lists UDf to your sample data
¹ A User Defined Function (aka UDF) is placed into a standard module code sheet. Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the function code into the new module code sheet titled something like Book1 - Module1 (Code). Tap Alt+Q to return to your worksheet(s).
Mate Juhasz answered the question very nice and simple, but now the answer dissapeared.
Mate wrote:
For r = 1 To 20
If Cells(r, 2) = "X" Then A = A & "; " & Cells(r, 1) Else
Next
And for me that solved it perfectly. Now "A" is a string as I wanted. Thank you so much!