I am not experienced in VBA coding at all and I have a seemingly simple question. I would like to create a click button macro which will find and select every currency formated cell which includes the euro symbol € or every currency formatted cell that has a sum above 0 within a specific column. At the moment this code :
Cells.Find(What:="€", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
is close to what I want to achieve (finds the € symbol) but it does not work on currency formatted cells which by default-automatically add the euro symbol to the sum..and is not defined to a specific column.
If for example in my worksheet only some currency formatted cells have a € symbol (which I am looking for), then macro gives me a Run-time error 91..The same exactly search parameters work fine using the native excel search function.
See pictures attached
Please kindly help it will help me a lot with my project =)
This doesnt work :
https://i.stack.imgur.com/UQqJp.jpg
This finds the euro symbol exactly as i would like my macro do.
https://i.stack.imgur.com/fM1lY.jpg
Part of your need. This routine will Select all cells containing the euro symbol. It will handle euros displayed by formatting as well as euros included in the cell text.
Sub test()
Dim rng As Range, r As Range, rFound As Range
Set rFound = Nothing
For Each r In ActiveSheet.UsedRange
If InStr(1, r.Text, "€") > 0 Then
If rFound Is Nothing Then
Set rFound = r
Else
Set rFound = Union(rFound, r)
End If
End If
Next r
If Not rFound Is Nothing Then rFound.Select
End Sub
Test the following-
Sub test()
Dim rng As Range
Set rng = Cells.Find(What:="€", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rng Is Nothing Then
rng.Activate
End If
End Sub
Related
I am not experienced in VBA coding.
My VBA code:
Search = InStr(ActiveCell.NumberFormat, Chr(128))
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
It searches and activates the cells which include the € symbol. It works only if I manually define my selection range.
When I try inserting ActiveSheet.Range("H:H").Select to make column H my selection (which is my goal), the code stops working.
The problem is in the ActiveCell, which is changing depending on what you are selecting. Try like this, you should get lucky:
Option Explicit
Sub TestMe()
Dim Search As String
ActiveSheet.Range("H:H").Select
Search = CStr(Chr(128))
Selection.Find(What:=Search, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select 'or .Activate
End Sub
Once you feel a bit better with recording macros, you may try to avoid ActiveSheet, Selection and ActiveCell:
How to avoid using Select in Excel VBA
This code found the cell with the Greek Euro format in the range A1:A6 on Sheet1 in the workbook containing the code (ThisWorkbook).
The cell must hold a value (to find blanks change "*" to "").
Sub Test()
Dim rRangeToSearch As Range
Dim rFoundRange As Range
Set rRangeToSearch = ThisWorkbook.Worksheets("Sheet1").Range("A1:A6")
Application.FindFormat.Clear
Application.FindFormat.NumberFormat = "#,##0.00 [$€-408]"
Set rFoundRange = rRangeToSearch.Find(What:="*", SearchFormat:=True)
If Not rFoundRange Is Nothing Then
MsgBox "Greek Euro format found in cell " & rFoundRange.Address
End If
End Sub
No idea why [$€-408] denotes Greek.
I created a macro which finds all matched values of a cell in a range. The user enter for example numb in the cell A2 Then every time he clicks on Find button it will show him the matched cell for example Order Number then purchase number then part number ...
Here is my code
Sub find_matched_cells()
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
ActiveWorkbook.Sheets("Sheet4").Range("A4:A104").Find(What:=(w), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End Sub
It works fine but when the user for example press on a cell not in my range then on the button find will not work. The issue is in
After:=ActiveCell
For example if by mistake you selected a cell in a range not in A4:A104 then the ActiveCell will not be in my range and it will give an error.
I need to add condition for example the first ActiveCell Starts from A4 and if I find the first matched cell then ActiveCell will take that value.
Any other suggestions please? Thank you very much.
One approach is this...
Sub find_matched_cells()
Dim Rng As Range
Set Rng = ActiveWorkbook.Sheets("Sheet4").Range("A4:A104")
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
If Intersect(ActiveCell, Rng) Is Nothing Then Range("A4").Select
Rng.Find(What:=(w), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End Sub
You could check the intersection. I would re-write the code slightly depending on what you need to actually do to each of these found cells - is it just select them? I have amended code below to avoid error if the value is not found.
Sub x()
Dim rFind As Range, sAddr As String, w
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
With ActiveWorkbook.Sheets("Sheet4").Range("A4:A104")
Set rFind = .Find(What:=w, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
sAddr = rFind.Address
Do
rFind.Select
MsgBox w & " found at " & rFind.Address
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> sAddr
End If
End With
End Sub
I am trying to fill a table with Input boxes with respect to date.
I am using the find and offset function to determine location through VBA but I want the "WHAT" to find to be dependent on date I put in a cell.
See my code below.
Public userMsg As String, Rng As Range
Private Sub Button1_Click()
Dim Data_Cell As Variant
userMsg = InputBox("How many brews were mashed?", "No of brews", "Enter your value here", 500, 700)
Data_Cell = Range("B2").Value
Set Rng = Sheet2.Range("A3:A34").Find(What:=Data_Cell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Rng Is Nothing Then
MsgBox "Captured"
Rng.Offset(0, 1) = userMsg
End If
End Sub
I found my problem, my source cell was a list from data validation, i used active x controls to do my list and it worked.
I am looking to find a variable within a row and return the column reference. The code I have written so far is;
Dim VarianceDate As String
VarianceDate = Sheets("Summary").Range("C12").Value
Rows("6").Find(What:=VarianceDate, After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
TargetCol = ActiveCell.Column
In this example the Variance date is 01/06/2015, however when I stepinto the code in VBA it returns nothing. Except When I search for it manually It finds the correct cell.
Eventually I would like to use the TargetCol reference to help me extract the correct data into another workbook.
Any help would be much appreicated.
Thanks
You need to mention that the search term is a date and also if the activecell is not in your find range, it will throw an error due to the inclusion of After:=ActiveCell
Try the following code
Sub FindDateCol()
Dim VarianceDate As String: VarianceDate = Sheets("Summary").Range("C12").Value
Dim TargetCell As Range, TargetCol As Integer
Set TargetCell = Rows("6").Find(What:=CDate(VarianceDate), LookIn:=xlFormulas, LookAt:=xlPart)
If Not TargetCell Is Nothing Then TargetCol = TargetCell.Column
MsgBox TargetCol
End Sub
I want to write a program in Visual Basic where I look at Column L of a worksheet and search for cells in Column L that contain "123." I then want to select the rows that contain "123" in Column L, copy them, and paste them into a new worksheet. How would I do this? I created a macro, but I'm not sure how to change it so that I can find multiple items and get all of the rows for those multiple items. Here's part of what the macro gave me:
Columns("L:L").Select
Selection.Find(What:="123", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Rows("1058:1058").Select
Selection.Copy
Sheets("123").Select
Rows("4:4").Select
range("C4").Activate
Selection.Insert Shift:=xlDown
Rows("5:5").Select
range("C5").Activate
Finds all 123s in the L column and copies the corresponding rows to Sheet2.
Tweak as needed.
Sub CopyRows()
Dim FoundRange As Range
Dim c As Range
For Each c In Application.Intersect(Columns("L"), UsedRange)
If c.Value like "*123*" Then
If FoundRange Is Nothing Then
Set FoundRange = c
Else
Set FoundRange = Application.Union(FoundRange, c)
End If
End If
Next
If Not FoundRange Is Nothing Then
FoundRange.EntireRow.Copy Worksheets("Sheet2").Range("A4")
End If
End Sub