Substitute Multi Values Excel using VBA - vba

I have a working function created(written by someone else) with the help of VBA to replace multiple strings, my problem is it replaces the 1st instance not the full value of the string, i will explain with an example.
Old Values
Car
Car Round Tyre
New Values
Bike
Bus
Now This Function can replace Car with Bike, but when it comes to "Car Tyre" it replaces Car with Bike and Ignores the "Tyre" Giving me Final Output as "Bike Round Tyre" but answer should be Bus
Function SubstituteMultiple(text As String, old_text As Range, new_text As Range)
Dim i As Single
For i = 1 To old_text.Cells.Count
Result = Replace(text, old_text.Cells(i), new_text.Cells(i))
text = Result
Next i
SubstituteMultiple = Result
End Function
This Function is very helpful but just needs to be polished.
Regards

If considering the full cell value is OK then:
Function SubstituteMultiple(text As String, old_text As Range, new_text As Range)
Dim i As Single, Result as String
Result = text
For i = 1 To old_text.Cells.Count
If text = old_text.Cells(i).Value Then
Result = new_text.Cells(i).Value
Exit For
End If
Next i
SubstituteMultiple = Result
End Function

Related

VBA Finding Max value, without using MAX function and printing corresponding cell

I think I need to do a loop here but I'm not quite sure how exactly to write out the syntax as I'm used to just using the max function.
The function I need to create takes in two arrays; the first array has the numeric values while the second array has strings. The function is supposed to find the value in the first array that is the largest and return the corresponding string from the second array.
I'm not sure exactly how to construct my loop. I'm thinking I need to use some form of conditional statements.
Here's what I have so far:
Function FindMax(valueArray() As Integer, nameArray() As String) As String
Dim i As Long, y As Long
y = valueArray(0) 'change to 1 if using a different array structure
FindMax = nameArray(0) 'change to 1 if using a different array structure
For i = LBound(valueArray, 1) To UBound(valueArray, 1)
If valueArray(i) > y Then
y = valueArray(i)
FindMax = nameArray(i)
End If
Next i
Debug.Print ; y
Debug.Print ; FindMax
End Function
Here's a worksheet formula that gets the job done quick & easy:
=INDEX($C$3:$C$10,MATCH(MAX($B$3:$B$10),$B$3:$B$10))
If your:
Numbers of which to find the Maximum are in cells B3:B10, and,
Strings that you want to return are in cells C3:C10
...then the Maximum can be found with:
{MyMax} =MAX($B$3:$B$10)
...and the "Position #` of {MyMax} can be found with:
{Pos#} =MATCH( {MyMax} ,$B$3:$B$10)
...and the corresponding string can be found with:
=INDEX($C$3:$C$10, {Pos#} )
...so if we put it all together, we get:
=INDEX($C$3:$C$10,MATCH(MAX($B$3:$B$10),$B$3:$B$10))
Function FindMax(valueArray() As Integer, nameArray() As String) As String
dim i as long, y as long
y = valueArray(0) 'change to 1 if using a different array structure
FindMax = nameArray(0) 'change to 1 if using a different array structure
for i = lbound(valueArray,1) to ubound(valueArray,1)
if valueArray(i) > y then
y = valueArray(i)
FindMax = nameArray(i)
end if
next i
End Function
Pay attention to the bottom half of the code. See where is say :
this=FindMax(arr,arr2)
?
That is how you call a function. Obviously you'll need two arrays to pass to this function. I suggest googling "Functions vba" and do some light reading.

Excel VBA with matches and index

I've written some VBA code with two matches and index formula. I need to pick the unique value from a sheet and compare it with the other sheet. However it is not working. I get some errors. (unable to get the match property of the worksheetfunction class vba - this is the error)
Here is my code :
Sub Post_Attendance()
Sheets("DB").Activate
'On Error Resume Next
Dim myvalue As String
Dim mydate As String
Dim mypost As String
(the date value entered in a cell)
Dim Dt As String
Dt = Range("C7").Value
(the unique id entered in a cell)
Dim empid As String
empid = Range("C8").Value
(activating another worksheet , from a cell value)
Dim strWsName As String
strWsName = Sheets("DB").Range("A7")
Sheets(Left(strWsName, 3)).Select
(match function to find the row and columns number for indexing)
mydate = WorksheetFunction.Match(Dt, Range("B1:Q1"), 0)
myvalue = WorksheetFunction.Match(empid, Range("A5:A500"), 0)
mypost = WorksheetFunction.Index(Range("B2:Q6"), myvalue, mydate)
End Sub
First off, WorksheetFunction.Match never returns a string; it either returns a number (a long integer) or an error. It is not the value from the match, it is the row or column number where the match was found.
Next, you cannot catch an #N/A error from no match with WorksheetFunction.Match but you can catch it with Application.Match into a variant.
Real dates are numbers, not strings. The raw underlying value is another long integer; e.g. a positive whole number with no decimal portion. If you had time or a datetime then you would have a decimal portion.
Resolve and reference your parent worksheet properly; do not rely upon Select or Activate.
The number returned from MATCH is the position within the range of cells searched. You are looking for a row number from row 5 to row 500 then using that to find a row within row 2 to 6; any match above row 9 (match returning 6 or above) in the original is going to be out-of-range.
If the empid values are numbers then deal with numbers; you cannot find a match to a true number from text-that-looks-like-a-number; e.g. 99 <> "99". I'm going to assume that empid should be alphanumeric and not a true number but given the errors with the previous variable assignments, it is up to you to determine the correct assignment.
Here is my best guess at an error controlled sub procedure (given that you have shown no sample data).
Option Explicit
Sub Post_Attendance()
'On Error Resume Next
Dim myvalueRow As Variant, mydateCol As Variant, dt As Long, empid As String, mypost As Variant
dt = Worksheets("DB").Range("C7").Value2
empid = Worksheets("DB").Range("C8").Value2
With Worksheets(Left(Worksheets("DB").Range("A7").Value2, 3))
'locate the column for the date
mydateCol = Application.Match(dt, .Range("B1:Q1"), 0)
If IsError(mydateCol) Then _
mydateCol = Application.Match(CStr(Worksheets("DB").Range("C7").Value2), .Range("B1:Q1"), 0)
If IsError(mydateCol) Then
Debug.Print "dt not found in row 1"
Exit Sub
End If
'locate the row for the value
myvalueRow = Application.Match(empid, .Columns("A"), 0)
If IsError(myvalueRow) Then
Debug.Print "empid not found in column A"
Exit Sub
End If
mypost = Application.Index(.Range("B:Q"), myvalueRow, mydateCol)
End With
End Sub

Excel formula calculating once then deleting

I have an excel formula:
=SplitKey(GetSysCd(INDEX([ReportValue],MATCH("mtr_make_model",[FieldName],0)),INDEX([ListName],MATCH("mtr_make_model",[FieldName],0))), 0)
which is running a few subroutines in VBA, but mainly matching values and inserting those values into a cell. When it finds a value for "mtr_make_model" it runs and matches the values inside a sys codes table. The issue I am having is that it is calculating once and then it removes the formula and now has solely the value... In the event that I go to the mtr_make_model field and change the value, the formula does not recalculate. Has anyone heard of this happening? Is this due to something in the VBA code? How do I make that formula stay put and if certain values change, the formula recalculates?
Thanks in advance.
Here are the two functions:
Public Function GetSysCd(ByVal name As String, sysCdTableName As String) As String
Dim r As Integer
Dim sysCdTable As Range
Dim nameList As Variant
Dim sysCd As String
On Error GoTo GetSysCd_Error
Set sysCdTable = Worksheets("sys_cd").Range(sysCdTableName)
nameList = WorksheetFunction.Index(sysCdTable, 0, 2)
r = WorksheetFunction.Match(name, nameList, 0)
sysCd = WorksheetFunction.Index(sysCdTable, r, 1)
GetOutOfHere:
On Error GoTo 0
GetSysCd = sysCd
Exit Function
GetSysCd_Error:
sysCd = ""
GoTo GetOutOfHere
End Function
Public Function SplitKey(s As String, v As Integer)
Dim aString As Variant
Dim r As Integer
If Len(s) > 2 Then
aString = Split(s, "_")
If v = 0 Or v = 1 Then
SplitKey = aString(v)
Else
SplitKey = aString(0)
End If
Else
SplitKey = ""
End If
End Function
I don't think the functions are relevant at this point, but rather just a matter of the function not recalculating when a variable in the formula changes...
The problem could be that Excel only recalculates functions when one of their arguments changes, and your GetSysCd function is referring to a range that is not in its argument list
Set sysCdTable = Worksheets("sys_cd").Range(sysCdTableName)
where sysCdTableName is just a string rather than a reference.
You can make the functions recalculate in real time by adding Application.Volatile True to the top of each function.

Convert VBA Macro to Function

I have been trying to create a function to retrieve column titles found in row four in an excel sheet. This is what I have so far, can anybody help me please?
Sub Test_Click()
Dim text As String
Dim titles(200) As String
Dim nTitles As Integer
For i = 1 To 199
If Trim(Sheets("Sheet1").Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = Sheets("Sheet1").Cells(4, i).Value
Next
For i = 0 To nTitles
Sheets("Sheet1").Cells(20 + i, 1).Value = titles(i)
Next
End Sub
You need to make an array function for this. So your function will take in inputs through a range
Function ReturnArray(Input as Range) as Variant
' Do stuff with the Input range
Dim Output(m,n) as Variant
'Loop through m,n to fill in the output values as you would in a range
ReturnArray = Output
End Function
And when you put in the function in excel, type it in the cell after highlighting where you want the output and press Ctrl-Shift-Return
Just as you write a Sub you can write a Function, just substitute the words at the beginning and at the end of your code.
Now, about how to return the values, obviously it will be an array, so you'll need to declare the array, set its size, fill its cells and return it. This can be done like this:
Function yourFunction() as String()
' You already have an array named "titles" which stores the values you want
' to return. Fill it exactly as you do in your original code.
yourFunction = titles ' This is the way to return the array.
End Function
If you want to use this function in a worksheet (as a formula), remember that this is an array-function, so you'll need to press Ctrl+Shitf+Enter after you enter the function in the cell instead of just [Enter].

How can I check if a cell in Excel spreadsheet contains number

I have a column of addresses and I have to find those which don't contain street numbers. Unfortunately, addresses have been input by various users and they do not follow the same pattern so the street type, street name, suburb are in different order and I can't use functions like LEFT, RIGHT or MID to check if particular character is a number. The column looks like this:
10 Willsons Drive, Manhattan
Epping, 23 Wet Rd
Longsdale St, Kingsbury
11 Link Crt, Pakenham
Is there an Excel or VBA function that can tell me if cell / string contains numbers?
Put this into a Module, then in your worksheet, may be a column next to it, put formula =HaveNumbers(A2) and check if you want it like that (True/False). You can change it to Return a String instead. This Returns TRUE / FALSE.
Function HaveNumbers(oRng As Range) As Boolean
Dim bHaveNumbers As Boolean, i As Long
bHaveNumbers = False
For i = 1 To Len(oRng.Text)
If IsNumeric(Mid(oRng.Text, i, 1)) Then
bHaveNumbers = True
Exit For
End If
Next
HaveNumbers = bHaveNumbers
End Function
There isn't a single VBA function that will do what you want, but the following function should do the trick:
Public Function ContainsNumbers(Inp As String) As Boolean
Dim Strings() As String, Str As Variant
Strings = Split(Inp, " ")
For Each Str In Strings
If IsNumeric(Str) Then
ContainsNumbers = True
Exit For
End If
Next
End Function
Then put something like =ContainsNumbers(A1) in a nearby cell.
Thanks Monty. In my case, though, numbers were not always separated from words so I had to iterate over each character. I used following:
Function ContainsNumber(text As String)
'checks if given cell contains number
For i = 1 To Len(text)
If IsNumeric(Mid$(text, i, 1)) Then
ContainsNumber = True
Exit Function
End If
Next
ContainsNumber = False
End Function