Transfer macro to UDF - vba

I want the macro below transferred to a UDF but I do not know how.
I want a udf where I select the Findstring and return it in the cell where is place the udf.
Can someone help me?
Sub Find_pipe()
Dim Findstring As String
Dim Location As String
Dim Rng As Range
Sub Find_First()
Dim Findstring As String
Dim Rng As Range
Findstring = InputBox("vul naam van leiding in")
If Trim(Findstring) <> "" Then
With Sheets("scenario 1V2").Range("A1:BP150")
Set Rng = .Find(What:=Findstring, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng.Offset(1), True
Application.Goto ThisWorkbook.Worksheets("D en L berekening").Range("A1"), True
ThisWorkbook.Worksheets("D en L berekening").Range("U10").Value = Rng.Offset(1).Value
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub

Try this:
Function FindPipe(Findstring As String)
Application.Volatile 'You need this if your UDF needs to update after changes in
' the search range
Dim f As Range
If Trim(Findstring) <> "" Then
With ThisWorkbook.Sheets("scenario 1V2").Range("A1:BP150")
Set f = .Find(What:=Findstring, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If Not f Is Nothing Then
FindPipe = f.Offset(1).Value
Else
FindPipe = "Not found"
End If
Else
FindPipe = ""
End If
End Function
Note the range to be searched is hard-coded in the UDF, so Excel doesn't know to recalculate your UDF if the search range is updated. I added Application.Volatile to take care of that but it may slow your workbook if you have a lot of formulas pointing to that UDF.

Related

Excel VBA- Subtracting Variable from Active Cell

Here's the code:
Sub Minus()
Dim numsub As Integer
If (D3 <> "") Then
numsub = Worksheets("Inventario 31-12-2015 ").Range("D3").Value
Dim FindString As Integer
Dim Rng As Range
FindString = ActiveWorkbook.Worksheets("Inventario 31-12-2015 ").Range("C3").Value
With Sheets("Inventario 31-12-2015 ").Range("C25:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If Not Rng Is Nothing Then
Application.Goto Rng.Offset(0, 4), True
ActiveCell.Value = ActiveCell.Value - numsub
End If
End If
End Sub
What I am trying to do is: Find the correct cell (This function should work as I had it already), select it and subtract the value of D3. As i am very new to VBA I can't get the code to work.
Any tips, feedback or comments are welcome and appreciated.
Thx
This answer picks up on the comments above, as well as tidying it up a little. (Does your sheet name really have a space at the end?)
Declaration of FindString changed as suggested by OP. Also I changed your Integer to Long, which is good practice (Google it for details).
Sub Minus()
Dim numsub As Long
Dim FindString As String
Dim Rng As Range
With Worksheets("Inventario 31-12-2015 ")
If .Range("D3") <> vbNullString Then
numsub = .Range("D3").Value
FindString = .Range("C3").Value
With .Range("C25:C100") 'change 100 to suit
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If Not Rng Is Nothing Then
Application.Goto Rng.Offset(0, 4), True
Rng.Offset(0, 4).Value = Rng.Offset(0, 4).Value - numsub
End If
End If
End With
End Sub

How to find cell containing string in entire worksheet

I would like to find a cell in a worksheet containing a specific string.
I won't know precisely how many columns or rows there will be in the spreadsheet, hence why I wanted to do it with CurrentRegion.
This is what I was trying:
=FIND("Data String", Range("A1").CurrentRegion)
You should have a look into the Microsoft References: Range.Find Method (Excel).
.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
Example:
Dim rngFound as Range
With Worksheets("MySheetName").Cells
Set rngFound = .Find("MySearchString", LookIn:=xlValues)
If Not rngFound Is Nothing Then
'something is found
else
'nothing found
End If
End With
searches the whole sheet
Try This
FindString = Sheets("Sheet1").Range("D1").Value
---------- This will select the next Cell in range with the inputbox value
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Find Value

Results depending if value found excel vba

I have 4 columns with names list. All columns are from different excel files. I want the value from cells from column E to change in Y or N depending if the value from column D is found in other columns A,B,C:
-Y: (if D is found in A)
-N: (if D is found in A and B) or (if D is found in C) or (if D is not found in A and B and C)
This is what i have until now :
Sub find_if_in_a_and_b()
Dim FindString As String
Dim Rng As Range
Findcell = Sheets("Sheet1").Range("D:D")
If Trim(Findcell) <> "" Then
With Sheets("Sheet1").Range("A:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Sub find_if_in_a_and_b_and_c()
Dim FindString As String
Dim Rng As Range
Findcell = Sheets("Sheet1").Range("D:D")
If Trim(Findcell) <> "" Then
With Sheets("Sheet1").Range("A:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Any help is welcomed.Thank you.
Like mates said, you dont need VBA. Make 3 auxiliary columns with "Found in A" "Found in B" "Found in C" with this formula COUNTIF(A:A;$D2) and check for Y or N. Check this image

coding a VBA excel function to search a string in a range

I am a rookie on excel...
I am trying to create a function that takes a text string as parameter, trims it (ie removes the extra spaces at the end and at the beginning), searches for the first occurrence of the string in a range (on another spreadsheet), and returns the actual content of that cell..
I've written the code below but however I tweak it, it never returns anything!!
Any help would be much appreciated !
Note: online I've found several examples of "subs" that do similar things, but when I try to convert them to a "function", they never work...
Public Function Find_First2(FindString As String) As String
Dim Rng As Range
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Find_First2 = Rng.Value
Else
Find_First2 = ""
End If
End With
End If
End Function
You verify that trimming won't empty the whole string but you still use it as is. I changed a few things, but I don't get what this is supposed to do. You search for a string and if you find it, you return the same string? In any case, here is the code. I tested it and it works. It will look in column A of sheet Feuil1 right now. Modify to suit your needs.
Sub test()
MsgBox Find_First2("aa")
End Sub
Public Function Find_First2(FindString As String) As String
Dim Rng As Range
Dim TrimString As String
TrimString = Trim(FindString)
If TrimString <> "" Then
With Sheets("Feuil1").Range("A:A") 'This is what you need to modify
Set Rng = .Find(What:=TrimString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Find_First2 = Rng.Value
MsgBox ("Found at: " & Rng.Address)
Else
Find_First2 = ""
End If
End With
End If
End Function

Creating an Excel Macro to Delete multiple rows at once

I found a code online and want to make edits to it. The code is in VBA and I want the macro code to delete multiple rows rather than one. Here is the code:
Sub findDelete()
Dim c As String
Dim Rng As Range
c = InputBox("FIND WHAT?")
Set Rng = Nothing
Set Rng = Range("A:A").Find(what:=c, _
After:=Range("A1"), _
LookIn:=xlFormulas, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Rng.EntireRow.Delete shift:=xlUp
End Sub
Instead of using find, use Autofilter and delete the VisibleCells
Sub findDelete()
Dim c As String, Rng As Range, wks as Worksheet
c = InputBox("FIND WHAT?")
Set wks = Sheets(1) '-> change to suit your needs
Set Rng = wks.Range("A:A").Find(c, After:=Range("A1"), LookIn:=xlFormulas, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
With wks
.Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).AutoFilter 1, c
Set Rng = Intersect(.UsedRange, .UsedRange.Offset(1), .Range("A:A")).SpecialCells(xlCellTypeVisible)
Rng.Offset(1).EntireRow.Delete
End With
End If
End Sub
EDIT
To replace the InputBox with Multiple Values to Find / Delete Do This:
Option Explicit
Sub FindAndDeleteValues()
Dim strValues() as String
strValues() = Split("these,are,my,values",",")
Dim i as Integer
For i = LBound(strValues()) to UBound(strValues())
Dim c As String, Rng As Range, wks as Worksheet
c = strValues(i)
'.... then continue with code as above ...
Next
End Sub
Just wrap it up in a While loop.
Sub findDelete()
Dim c As String
Dim Rng As Range
c = InputBox("FIND WHAT?")
Set Rng = Nothing
Do While Not Range("A:A").Find(what:=c) Is Nothing
Set Rng = Range("A:A").Find(what:=c, _
After:=Range("A1"), _
LookIn:=xlFormulas, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Rng.EntireRow.Delete shift:=xlUp
Loop
End Sub
You already have the code to delete rows in Rng.EntireRow.Delete shift:=xlUp, what you need is the code to set the range to the rows which you want to delete. As usual in VBA, this can be done in a lot of ways:
'***** By using the Rng object
Set Rng = Rows("3:5")
Rng.EntireRow.Delete shift:=xlUp
Set Rng = Nothing
'***** Directly
Rows("3:5").EntireRow.Delete shift:=xlUp
Your Find statement only finds the first occurrence of c, that's why it's not deleting more that one row.