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!
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 am trying to do a few things with this subroutine.
First i need to insert a row after every 18th row
Then i need to insert a string in column A based on the string in the above row (i.e. 17th row in the first iteration).
Finally i need to insert a string in column B of the ith row again based on the previously established string.
So in Layman's terms, row 17 will say 120F_CASH
i want to find "_ " and take the characters in the string from the left of the "_ ", then in row 18 i want to put 120F & "_MULTI_STRAT" in column A
in column B of row 18, i want to insert "SSELECT PERF.IMST.INDEX WITH ENTITY = " & "120F" & "AND WITH CATEGORY1 = ""01"""
here's my code:
Option Explicit
Sub InsertRowEveryXrows()
Dim r As Long, lr As Long
Dim code As String
lr = Range("A" & Rows.Count).End(xlUp).Row
For r = 18 To lr Step 18
Rows(r).Insert Shift:=xlDown
Set code = Left(Range(Cells(r - 1, "A"), InStr(1, "_", Cells(r, "A")) - 1))
Cells(r, "A") = code & "_MULTI_STRAT"
Cells(r, "B") = "SSELECT PERF.IMST.INDEX WITH ENTITY = " & code & "AND WITH CATEGORY1 = ""01"""
Next r
End Sub
i am getting a compile error: Wrong number of arguments or invalid property assignments on this line:
Set code = Left(Range(Cells(r - 1, "A"), InStr(1, "_", Cells(r, "A"))
- 1))
the string's location is in row 17 (r-1) in column A & the number of characters is found by looking for "_"
What am i missing?
*fyi i had to add a space after the underscore for it to show up properly here, however, there SHOULD NOT be a space after the underscore.
Set code = Left(Range(Cells(r - 1, "A"), InStr(1, "_", Cells(r, "A")) - 1))
The Left function wants a string and an integer, but you haven't provided the integer. Here's the same expression, without the outer Left function call:
Set code = Range(Cells(r - 1, "A"), InStr(1, "_", Cells(r, "A")) - 1)
Notice anything? The result of InStr is being passed as the 2nd argument to the (unqualified) Range property, and that isn't what you intended.
In fact, you don't need that Range call at all. This should be closer to your intent:
Set code = Left(Cells(r - 1, "A"), InStr(1, "_", Cells(r, "A")) - 1)
Note that there is quite a bit of implicit code going on here; made explicit, reads like this:
Set code = Left(ActiveSheet.Cells(r - 1, "A").Value, InStr(1, "_", ActiveSheet.Cells(r, "A").Value) - 1)
Do you really intend to be working of just whatever worksheet happens to be active? Most likely not, but if so, consider explicitly qualifying these Cells calls with ActiveSheet. If you mean to be working with a specific sheet, use that sheet object as a qualifier instead.
Now, you're using Set for this assignment, but code is not an object reference, and that is another problem.
Strings are not objects in VBA, they're assigned with the regular value assignment syntax. That is, without a Set keyword (you could have the legacy Let keyword there if you wanted, but it's not needed):
code = Left(ActiveSheet.Cells(r - 1, "A").Value, InStr(1, "_", ActiveSheet.Cells(r, "A").Value) - 1)
Now, Range.Value (explicit here, implicit in your code) will be a Variant, not a String. In most cases, it won't matter.
Until one cell has a Variant/Error subtype (think #N/A, or #VALUE! worksheet errors); then everything blows up with a type mismatch error. To avoid this, you can use the Text of the cell instead of its Value, or you can pull that value into its own local Variant variable, and only proceed to treat it like a string when IsError returns False for it.
You could use something like so
Function Pop_String(strInput As String, strDelim As String, Optional lngInstance = 1)
Dim aTemp() As String
aTemp = Split(strInput, strDelim, lngInstance + 1)
Pop_String = aTemp(lngInstance - 1)
End Function
Calling like so
Pop_String("a-b-c-d-e-f","-",4) returns d
Pop_String("a-b-c-d-e-f","-",2) returns b
I would add some error checking too, the default (without 3rd argument) is the first section, so
Pop_String("test-string","-") would return test and
Pop_String("test-string","-",2) would return string.
I am totally new to VBA and I am struggling a little bit with one thing. I want to make a macro, which checks values in "M" column. If value is higher than 5, then print "hello". If not then print "x". Unfortunately, I only gets "x" back in selected cells.
Private Sub costam()
Dim i As Integer
Dim a As Integer
a = 13
For i = 1 To Range("M" & Rows.Count).End(xlUp).Row
If Cells(a, i).Value > 5 Then
Range(Cells(1, i), Cells(10, i)).Value = "hello"
Else
Range(Cells(1, i), Cells(10, i)).Value = "x"
End If
Next i
End Sub
I know this problem is silly and takes like 1 minute to solve, but I am trying to apply some alike problems but without any progress.
You could create a custom function for this workbook.
Public Function CustomFunction(myVal As Integer)
Dim myResult As String
If myVal > 5 Then
myResult = "Hello"
Else
myResult = "X"
End If
CustomFunction = myResult
End Function
Then, you would write a formula in the cell where you want the value to be returned.
=CustomFunction(A2)
Your custom function will need to be placed into a module.
Excel VBA User-Defined Functions Tutorial
I am using the following Index Match function to get the name of a company where the spend data matches that of which I type into cell BF17.
=INDEX($AM$16:$BB$16,MATCH(BF17,AM17:BB17,0))
What I want to be able to do is list multiple results within the same cell and separate these with a comma.
Does anyone know if this is possible and if so can someone please show me how?
Thanks
Code:
Insert this code in a module in your workbook:
Public Function hLookupList(KeyVal, Vals As Range, Ret As Range) As String
Dim i As Long
Dim vw As Worksheet
Dim rw As Worksheet
Dim RetStr As String
Application.Volatile True
Set vw = Vals.Worksheet
Set rw = Ret.Worksheet
If Vals.Rows.Count > 1 Then
hLookupList = "Too Many Value Rows Selected!"
Exit Function
End If
If Ret.Rows.Count > 1 Then
hLookupList = "Too Many Return Rows Selected!"
Exit Function
End If
If Vals.Columns.Count <> Ret.Columns.Count Then
hLookupList = "Value Range and Return Range must be the same size!"
Exit Function
End If
For i = Vals.Column To Vals.Column + Vals.Columns.Count - 1
If vw.Cells(Vals.Row, i) = KeyVal Then
RetStr = RetStr & rw.Cells(Ret.Row, Ret.Column + i - 1) & ", "
End If
Next i
hLookupList = Left(RetStr, Len(RetStr) - 2)
End Function
Then:
Insert this in the cell where you want your list: =hLookupList(BF17, $AM$16:$BB$16, $AM$17:$BB$17)
Unfortunately there is no built-in way to make a vlookup or index/match function return an array. You could do it with a custom formula or if you know there are a limited number of results, a few nested lookups. Lewiy at mrexcel.com wrote a great custom function that I use, which can be found here. This function can be slow if you are looking up a large number of rows.
Since you are looking up columns and want commas separating the results instead of spaces, you will need to modify the code as follows:
Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim r As Range
Dim result As String
result = ""
For Each r In lookuprange
If r = lookupval Then
result = result & "," & r.offSet(indexcol, 0)
End If
Next r
result = Right(result, Len(result) - 1)
MYVLOOKUP = result
End Function
Your formula would then be =MYVLOOKUP(BF17,AM17:BB17,-1)
If you want a space after the comma (in the results), change:
result = result & "," & r.offSet(indexcol, 0)
to
result = result & ", " & r.offSet(indexcol, 0)
If you haven't used custom functions before, hit Alt + F11 when in Excel to bring up the VBE, and add a new module to the workbook you are working on (Insert --> Module). Just copy and paste this code in there. I would recommend Paste Special --> Values before sending the workbook to anyone. Let me know if you have any questions implementing it!