Results depending if value found excel vba - 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

Related

Transfer macro to UDF

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.

How to get the value of the row number in which the value is found in this code?

How do I get the range or the row number in which the value is found in the following code?
In the If section, I want the row number instead of going to the value like here in this piece of code
With wsSource.Range("A:A") 'searches all of column A
Set Rng1 = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng1 Is Nothing Then
Application.Goto Rng1, True 'value found
Else
MsgBox "Nothing found" 'value not found
End If
End With
Activate the Rng1 and then get active cell row like below.
With wsSource.Range("A:A") 'searches all of column A
Set Rng1 = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng1 Is Nothing Then
'Your code
Rng1.Activate
'Get Row number
MsgBox ActiveCell.Row
'Get Row value
MsgBox ActiveCell.Value
Else
MsgBox "Nothing found" 'value not found
End If
End With

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 select a date with a set cell color in Excel?

I am trying to create a macro in excel VBA, that searches the Range (B1:B30) of the value of the ActiveCell in Column “B” by a loop. Along with the search of Column, I also want to check if the date’s cell is colored with a particular color. If the date's cell equals the set color "Good", then I want it to change the color of the cell in Column H of the same row as selected to red.
When I run the code, I get an error message of “Run-time error ‘424’: Object required.” When I go to debug the problem, it highlights the .Find function I have and points to the last line of the search which is “SearchFormat:=False).Activate” What should I do to fix this problem?
Any improvement with my overall code will be very much appreciated.
Sub Find()
Dim FirstAddress As String
Dim MySearch As Variant
Dim Rng As Range
Dim I As Long
MySearch = Array(ActiveCell)
With Sheets("Sheet1").Range("B1:B30")
For I = LBound(MySearch) To UBound(MySearch)
Set Rng = .Find(What:=MySearch(I), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False).Activate
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If ActiveCell.Style.Name = "Good" Then
Rng("H" & ActiveCell.Row).Select
Rng.Interior.ColorIndex = xlColorIndexRed
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub
Showing the Debug mode of the run-time error.
Screenshot of the Spreadsheet for reference
Code Review:
You have several problems here.
MySearch = Array(ActiveCell) will always be a single value. So why bother looping through it
You cannot set a range to equal range.activate. Searching Sheets("Sheet1").Range("B1:B30") implies that you are searching a worksheet other that the ActiveSheet. If this is the case than .Find(After:=Activecell) suggests that you are looking for a value after the ActiveCell of another worksheet.
Set Rng = .Find(What:=MySearch(I), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False).Activate
Rng("H" & ActiveCell.Row) Rng is a Range object. It doesn't work like Range. You cannot pass it a cell address. You can do this Rng(1,"H") which is really shorthand for Rng.cells(1,"H") bit that is misleading because Rng is in column 2 Rng(1,"H") will reference the value in column I.
Sub Find()
Dim FirstAddress As String
Dim MySearch As Variant
Dim Rng As Range
Dim I As Long
MySearch = ActiveCell 'This is the ActiveCell of the ActiveSheet not necessarily Sheets("Sheet1")
With Sheets("Sheet1").Range("B1:B30")
Set Rng = .Find(What:=MySearch, _
After:=.Range("B1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If Rng.Style.Name = "Good" Then
.Range("H" & Rng.Row).Interior.ColorIndex = xlColorIndexRed
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
End With
End Sub
UPDATE:
Here is the actual answer to your question:
Sub FindMatchingValue()
Const AllUsedCellsColumnB = False
Dim rFound As Range, SearchRange As Range
If AllUsedCellsColumnB Then
Set SearchRange = Range("B1", Range("B" & Rows.count).End(xlUp))
Else
Set SearchRange = Range("B1:B30")
End If
If Intersect(SearchRange, ActiveCell) Is Nothing Then
SearchRange.Select
MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
Exit Sub
End If
Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False)
If Not rFound Is Nothing Then
Do
If rFound.Style.Name = "Good" Then
Range("H" & rFound.Row).Interior.Color = vbRed
End If
Set rFound = SearchRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
End If
End Sub
You can't put Activate at the end of the findthe way you are trying to do.
Try this as you find statement.
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Rng.Activate
Then if you want to Activate the range, do that. But, it is best to stay away from Select, Activate etc in VBA code. I strongly suggest not using that last line of code and adjust you code to not rely on Select and Activate.
you may want to consider an Autofilter approach so as to loop only through relevant cells, as follows:
Option Explicit
Sub Find()
Dim cell As Range
With Sheets("Sheet1").Range("B1:B30")
.Rows(1).Insert '<--| insert a dummy header cell to exploit Autofilter. it'll be removed by the end
With .Offset(-1).Resize(.Rows.Count + 1) '<--| consider the range expanded up to the dummy header cell
.Rows(1) = "header" '<--| give the dummy header cell a dummy name
.AutoFilter field:=1, Criteria1:=ActiveCell '<--| filter range on the wanted criteria
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell other than "header" one has been filtered...
For Each cell In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) '<--| ... loop through filtered cells only
If cell.Style.Name = "Good" Then cell.Offset(, 6).Interior.ColorIndex = 3 '<--| ... and color only properly styled cells
Next cell
End If
.AutoFilter '<--| .. show all rows back...
End With
.Offset(-1).Resize(1).Delete '<--|delete dummy header cell
End With
End Sub

Find if a value in a cell exists in another range/cell

I need a piece of code that takes the value from a cell and checks another column for that value and then returns a true/false answer or similar.
Then I will use a conditional to say something like
If "Value in cell B1" exists in Column C Then
Do nothing
Else
Msgbox "Please enter existing/valid value in B1"
End if
I simply cannot figure out how to do this. Thanks in advance for any help!
Rgards
Jim
You can use Range.Find to do this.
Dim rng as Range
Set rng = Range("C:C").Find(What:=Range("B1").Value), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rng is nothing Then
Msgbox "Please enter existing/valid value in B1"
Else
' value of b1 found in column C
' do something else
End If
This will check whether the value of cell B1 is in any cell of column C.
The rng variable will point to the first occurence of the b1 value in column C.
More about all parameters of .find can be found at msdn: https://msdn.microsoft.com/de-de/library/office/ff839746.aspx
Something like this should work. Insert into a new module in your VBA editor, then use the custom function in a Worksheet like so:
=find_string(B1,C:C)
Function Find_String(ByVal SearchTerm As String, ByVal Rng As Range) As String
Dim FindString As String
If Trim(SearchTerm) <> "" Then
With Rng
Set Rng = .Find(What:=SearchTerm, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Do something!
'Examples:
Application.Goto Rng, True
Find_String = "Found in cell " + Rng.Address
Else
MsgBox "Please enter existing/valid value in B1"
Find_String = "Nothing Found"
End If
End With
End If
End Function