Im tring to get my Function to skip words in my list that arent in my string but it doesnt seem to be working
Iv tried using VBA and excel native commands... however i get the same result
Public Function test(range, y)
step = y
For Each cell In range
If InStr(cell, step, vbTextCompare) <> 0 Then
step = Application.WorksheetFunction.Replace(step,Application.WorksheetFunction.Search(cell, step), Len(cell), UCase(cell))
test = step
End If
Next cell
End Function
When I try to use this Function in Excel I get #VALUE, I suspect this is because not all the values in the list are found in the string however that the reason for the if statement
first you have the variable backwards in the Instr. and you must use the firs criterion if you use the last.
Also if you are looking for complete words then you need to use " " on the search and replace.
Lastly use vba's Replace:
Public Function test(rng As range, y As String)
Dim step As String
step = y
Dim cell As range
For Each cell In rng
If InStr(1, " " & step & " ", " " & cell & " ", vbTextCompare) > 0 Then
step = Replace(" " & step & " ", " " & cell & " ", UCase(" " & cell & " "))
End If
Next cell
test = Application.Trim(step)
End Function
Related
I would like to get the data from several rows from one sheet sheet1 into a single cell on another sheet sheet2 based on a lookup.
For example there is data on one sheet :
sheet1
And I would like to lookup data based on id and return all the concerning rows into one cell like this:
sheet2
Is that possible with an excel formula or is this only solvable with VBA?
Thank you for your help in advance.
I found a vba that came close to a solution but didn't work. I've looked at "index, match" functions "small" functions but could find a solution that puts data into a single cell...
This is the vba code I found that came close to solution:
'Function SingleCellExtract(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)
Dim i As Long
Dim Result As String
For i = 1 To LookupRange.Columns(1).Cells.Count
If LookupRange.Cells(i, 1) = Lookupvalue Then
Result = Result & " " & LookupRange.Cells(i, ColumnNumber) & ","
End If
Next i
SingleCellExtract = Left(Result, Len(Result) – 1)
End Function'
the vba threw value or compile errors.. it looks like it only returns values from one vertical column
"Is that possible with an excel formula or is this only solvable with VBA?"
It sure is possible through formula, but you'll have to have access to the TEXTJOIN function:
Formula in H2:
=TEXTJOIN(CHAR(10),TRUE,IF($A$2:$A$11=G2,$B$2:$B$11&", "&$C$2:$C$11&", "&$D$2:$D$11&", "&$E$2:$E$11,""))
Note: It's an array formula and need to be confirmed through CtrlShiftEnter
Drag the formula down and make sure you got textwrap selected on column H.
No access to TEXTJOIN? You can always create your own, for example:
Function TEXTJOIN(rng As Range, id As Long) As String
For Each cl In rng
If cl.Value = id Then
If TEXTJOIN = "" Then
TEXTJOIN = cl.Offset(0, 1) & ", " & cl.Offset(0, 2) & ", " & cl.Offset(0, 3) & ", " & cl.Offset(0, 4)
Else
TEXTJOIN = TEXTJOIN & Chr(10) & cl.Offset(0, 1) & ", " & cl.Offset(0, 2) & ", " & cl.Offset(0, 3) & ", " & cl.Offset(0, 4)
End If
End If
Next cl
End Function
In cell H2 you can call the UDF through =TEXTJOINS($A$2:$A$11,G2) and drag down. Again, make sure textwrapping is checked for the column.
EDIT:
As per OP's comment, this is how I got the data to show correctly:
Select column H and click textwrap + top alignment as shown in this screenshot:
Next, select all cells if result is not correct yet:
Double-click the line between columns and rows to space them to fit the data
1. I was trying to answer VBA UDF to split string array and got an unpleasant results during computing my UDF.
Public Function mytest(src, dest)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ")"
mytest = "wut"
End Function
Sub test(src As Range, dest As Range)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case ","
rows = rows + 1
Case ";"
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Expected results:
Formula results:
Can someone explain why does it double Value of the cell?
When I debugged test using
Sub ffs()
Call test(Cells(1, 1), Cells(3, 1))
End Sub
I got expected results, so I guess the problem is not in the test Sub?..
2. Whenever I try to add more parameters to Function and Sub (for example delimiters) Function doesn't Evaluate Sub at all
Public Function CellToRange(src, dest, DelimL, DelimC)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
CellToRange = "wut"
End Function
Sub CTR(src As Range, dest As Range, Delim1, Delim2)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case Delim1
rows = rows + 1
Case Delim2
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Please help ._. and thanks in advance.
Solution:
Thanks Billy and Charles Williams.
Change
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
To
dest.Parent.Evaluate "0+CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
Thanks everyone!
The problem lies with the Worksheet.Evaluate method which is being used to get round the restriction that a UDF is not allowed to modify the worksheet structure.
Consider this code
Option Explicit
Public Function dummyudf() As String
Debug.Print "Calling Evaluate method"
ActiveSheet.Evaluate "testsub()"
Debug.Print "Returning From Evaluate method"
dummyudf = "done"
End Function
Sub testsub()
Debug.Print "testsub running"
End Sub
Sub testmacro()
Dim s As String
Debug.Print "testmacro running"
s = dummyudf
End Sub
The UDF dummyudf() uses the Evaluate method to invoke the Sub called testsub(). These are analagous to mytest and test in part 1. of the OP and to CellToRange and CTR in part 2 but are stripped down to the bare minimum.
testsub() can also be invoked directly as a macro. A second macro testmacro invokes dummyudf as a function in VBA.
The following output was obtained from the Immediate Window:
As can be seen
when invoked as a macro: testsub() behaves as expected
when dummyudf() is invoked as a UDF on the worksheet (for example by adding the formula =dummyudf() to cell A1 the Evaluate method appears to call testsub() twice
when dummyudf() is invoked as a function in VBA by running testmacro() as a macro the Evaluate method appears to call testsub() twice.
The documentation here suggests that the Name argument of the Worksheet.Evaluate method should be the name of an object, so it is a bit surprising that it is possible supply the name of a Sub. That it also seems to call any such Sub twice, is even more surprising but does underline the advice given in YowE3K's answer about not using this hack in a UDF. I'd go further: don't use Worksheet.Evaluate with any Sub.
1) It evaluates once when the formula is triggered, and again when cell A3 is updated by the function (as it is one of the cells the formula is dependent on).
2a) You are calling the wrong subroutine (test instead of CTR)
2b) You need to call your second function using something like
=CellToRange(A1;A3;""",""";""";""")
or else change the line in your code calling CTR to be
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", """ & DelimL & """, """ & DelimC & """)"
3) I strongly recommend that you do not use this sort of hack to get a UDF to update cells other than the one containing the function.
I'm writing a macro which should run queries to transfer data from excel to a Access database, and everything is working fine, however, if I want to use a String in one of these queries, I've to type them like this:
'" & Lijn & "'
I know that the following code (which is written in VBA) is way easier to write in Javascript, by using question marks and setString:
VBA:
Dim ShiftsQ As String
ShiftsQ = "INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES ('" & Lijn & "', '" & Operator & "', '" & Ploeg & "', '" & Teamleider & "');"
Javascript:
var ShiftsQ = SQL.prepareStatement(INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES (?, ?, ?, ?);
ShiftsQ.setString(1, Lijn);
ShiftsQ.setString(2, Operator);
ShiftsQ.setString(3, Ploeg);
ShiftsQ.setString(4, Teamleider);
Is there anyway to write the VBA code like the Javascript one?
As far as I know, there is nothing like the .NET string.Format() method VBA. But you could write your own version of such a function that uses deputys and returns a formatted string.
Private Sub Main()
' Your actual query
' The deputys are indexed in curley brackets (inspired from the .NET syntax of the equivalent function, making your code easy to read for .NET programmers)
Dim qry As String
qry = "SELECT {0}, {1} FROM {2} WHERE {3}"
' The values to set for the deputys in your query
Dim parameters(3) As String
parameters(0) = "firstname"
parameters(1) = "lastname"
parameters(2) = "users"
parameters(3) = "userID = 'M463'"
' For demo purposes, this will display the query in a message box
' Instead of the MsgBox, you would use the formatted query to execute against the database
MsgBox FormatString(qry, parameters)
End Sub
' This is where the magic happens, the deputys in the given string will be replaced with the actual values from the provided array
Private Function FormatString(strInput As String, paramValues() As String)
' This will be our return value
Dim strOutput As String
strOutput = strInput
' Verify that the given count of parameters matches the given count of deputys in the input string
Dim maxParamIndex As Integer
maxParamIndex = UBound(paramValues)
Dim deputyCount As Integer
For i = 1 To Len(strOutput) + 1 Step 1
If Mid(strOutput, i, 3) = "{" & deputyCount & "}" Then
deputyCount = deputyCount + 1
End If
Next
' If there is a mismatch between the count of parameters and the count of deputys, display exception message and exit the function
' Adding +1 to maxParamIndex is neccessary, as maxParamIndex refers to the maximum index (starting at 0, not 1) of the given array and deputyCount refers to the actual count of deputys (starting at 1)
If maxParamIndex + 1 <> deputyCount Then
MsgBox "Number of deputys has to match number of parameters for the given string:" & vbCrLf & strInput, vbCritical, "Exception in Function FormatString"
FormatString = ""
End If
' Iterate through the array and replace the deputys with the given values
For i = 0 To maxParamIndex Step 1
strOutput = Replace(strOutput, "{" & i & "}", paramValues(i))
Next
' return the formatted string
FormatString = strOutput
End Function
Result of example:
If I face this problem I would simply solve it on my own (althoug there might be other "standard" solutions), by defining my own simple, global function (put in in any standard code module)
Public Function S_(str as String) as String
S_ = chr(39) & str & chr(39)
End Function
ShiftsQ = "INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES (" & S_(Lijn) & ", " & S_(Operator) & ", " & S_(Ploeg) & ", " & S_(Teamleider) & ");"
This way, I will follow a simple and systematic rule in all my project, that is call S_(param) on any parameter of text type in my queries...
I have the following string "123 - 456789". What I am trying to do is find a way to only capture the remaining characters after the second space - "456789" - regardless the length of the string.
I have the follow set of code:
For leftLoop = 2 To leftNumberOfCells
Range("A" & iRow) = Split(Range("B" & iRow).Value, " ")
Range("B" & iRow) = Mid("B" & iRow, InStr("B" & iRow, " "), 100)
iRow = iRow + 1
Next leftLoop
The code line "Range("B" & iRow) = Mid("B" & iRow, InStr("B" & iRow, " "), 100)" is what I tried, among other ways (from searching online, but I can't seem to get it to work.
I have two questions:
Does someone know what the correct code should be? and...
Can I reference the cell where the string is located and replace it in that same cell after doing the mid function without having to temporarily put it into another cell and copy and paste it back? For example, my string "123 - 456789" is in cell B2, is there a way to code it so I can reference cell B2 and simultaneous replace the cell B2 with "456789" and not having to place it in another cell then copy and paste it back into B2. I hope you get what i'm asking.
Thanks for you help!
This addresses part 2.
Sub strings()
Dim replace As String
Dim bCell As Range
For leftLoop = 2 To leftNumberOfCells
Set bCell = Range("B" & iRow)
replace = Mid(bCell, InStr(bCell, "-") + 2, 100)
Range("B" & iRow) = replace
iRow = iRow + 1
Next leftLoop
End Sub
Try this:
result = Split(TextToSplit, " ", 3)(2)
Split(TextToSplit, " ", 3) will split the text on spaces, returning a zero-based array. The last argument 3 limits the splitting to 3 portions: before the first space, between the first and second space, and everything else. The (2) at the end of the statement returns the last element of the array.
Hope that helps
Let's say I have this string which represents a cell: A2.
What should I do to covert it to coordinates: (2, 1) ?
Without VBA
Suppose, cell C2 contains string "A2".
Then
=INDIRECT(C2) returns reference to A2
=ROW(INDIRECT(C2)) returns row number - 2
=COLUMN(INDIRECT(C2)) returns column number - 1
="(" & ROW(INDIRECT(C2)) & "; " & COLUMN(INDIRECT(C2)) & ")" returns coordinates in format (x; y) - (2; 1)
UPD:
If you're using UDF, change your parameter type from String to Range:
Function GetData(Cell As Range)
MsgBox "My row is " & Cell.Row
MsgBox "My column is " & Cell.Column
End Function
if you call this UDF from worksheet like this: =GetData(A2), msg box would pop-up:
"My row is 2"
"My column is 1"
You can use Column and Row properties of the Range object:
Range("A2").Row
Range("A2").Column
Examlpe:
Sub test()
Dim x As String
x = "A2"
MsgBox GetRow(x) & " " & GetColumn(x)
End Sub
Function GetRow(Cell As String)
GetRow = Range(Cell).Row
End Function
Function GetColumn(Cell As String)
GetColumn = Range(Cell).Column
End Function