VBA Excel find function for currency formatted cells

[Kwnstantinos]

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


https://imgur.com/a/IRZvF
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 advise, it will help me a lot with my project =)

 

[Roderick_E]

Re: VBA Excel find function for currency formatted cells - Please advise

No column H is not merge with any other column. Wghen i click the button with your code, it gives me the message "Select column H or a cell in column H to begin" but even when i manually select column H (as the message says) it still does not find the cells that contain the euro symbol

I've tested this several times and it works as expected.
It will not select column H for you. I purposely have you select column H since the code is doing 2 things:
1. Searching from the top of column H
2. OR...searching the next row in column H for euro symbol.

So, if you select column H and press the button, does it do anything? A popup or anything? What it's suppose to do is select the next euro formatted cell in column H every time you press the button. Are you sure the cell is formatted with euro and doesn't have an actual euro symbol?

UPDATE:
Upon further research, are you in the USA? It is possible that alt+128 doesn't create a euro sign for you. In a blank cell, please press alt+128 and see if it is a euro sign. Thanks

 

[Roderick_E]

Re: VBA Excel find function for currency formatted cells - Please advise

Ok, I'm using a hex code now... see if this works:

Sub euroselector()
If Not Intersect(Selection, Columns("H")) Is Nothing Then
    If Intersect(Selection, Columns("H")).Address = Columns("H").Address Then
    lastrow = Columns("H").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
     For x = 1 To lastrow
     If InStr(Cells(x, "H").NumberFormat, [COLOR=#ff0000]ChrW(&H20AC)[/COLOR]) > 0 Then
     Cells(x, "H").Select
     Exit Sub
     End If
     Next x
        Else
lastrow = Columns("H").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
For x = ActiveCell.Row + 1 To lastrow
     If InStr(Cells(x, "H").NumberFormat, [COLOR=#ff0000]ChrW(&H20AC)[/COLOR]) > 0 Then
     Cells(x, "H").Select
     Exit Sub
     End If
     Next x
End If
Else
MsgBox "Select column H or a cell in column H to begin", vbInformation, "ALERT"
End If
End Sub

 

[Kwnstantinos]

Re: VBA Excel find function for currency formatted cells - Please advise

Ok, I'm using a hex code now... see if this works:

Sub euroselector()
If Not Intersect(Selection, Columns("H")) Is Nothing Then
    If Intersect(Selection, Columns("H")).Address = Columns("H").Address Then
    lastrow = Columns("H").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
     For x = 1 To lastrow
     If InStr(Cells(x, "H").NumberFormat, [COLOR=#ff0000]ChrW(&H20AC)[/COLOR]) > 0 Then
     Cells(x, "H").Select
     Exit Sub
     End If
     Next x
        Else
lastrow = Columns("H").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
For x = ActiveCell.Row + 1 To lastrow
     If InStr(Cells(x, "H").NumberFormat, [COLOR=#ff0000]ChrW(&H20AC)[/COLOR]) > 0 Then
     Cells(x, "H").Select
     Exit Sub
     End If
     Next x
End If
Else
MsgBox "Select column H or a cell in column H to begin", vbInformation, "ALERT"
End If
End Sub

Thank very much for your time spent to help me but unfortunatelly this code does nothing in my worksheet..You could see yourself by teamviewer if you want

 

[Rick Rothstein]

Re: VBA Excel find function for currency formatted cells - Please advise

Thank very much for your time spent to help me but unfortunatelly this code does nothing in my worksheet..You could see yourself by teamviewer if you want

I think I may have an approach you can try, but first (because the Euro is not my native currency) I need you to select a currency formatted cell, the right click that selected cell and click on "Format Cells..." in the popup menu that appears, then select the Number tab, click the Custom item in the "Category" list and copy what is shown in the "Type" field and paste it into a response here. From that, I think I will be able to cobble some code for you to try (you will have to "proof" my code because I won't be able to so it here because of my non-Euro settings).

 

[Kwnstantinos]

Re: VBA Excel find function for currency formatted cells - Please advise

I think I may have an approach you can try, but first (because the Euro is not my native currency) I need you to select a currency formatted cell, the right click that selected cell and click on "Format Cells..." in the popup menu that appears, then select the Number tab, click the Custom item in the "Category" list and copy what is shown in the "Type" field and paste it into a response here. From that, I think I will be able to cobble some code for you to try (you will have to "proof" my code because I won't be able to so it here because of my non-Euro settings).

#,##0.00€ <------------- This is what i got sir =)

 

[Rick Rothstein]

Re: VBA Excel find function for currency formatted cells - Please advise

#,##0.00€ <------------- This is what i got sir =)

See if this macro works for you...

[table="width: 500"]
[tr]
	[td]Sub SelectNonZeroCurrencyCells()
  Dim C As Range, Addr As String
  Set C = ActiveCell.Offset(1)
  If Not C Is Nothing Then
    Addr = C.Address
    Do
      If C > 0 And AscW(Right(C.Text, 1)) = 8364 Then
        C.Select
        Exit Sub
      Else
        Set C = ActiveCell.EntireColumn.Find("*", C, xlValues, xlPart, , xlNext, , False)
      End If
    Loop While Not C Is Nothing And C.Address <> Addr
  End If
End Sub[/td]
[/tr]
[/table]

 

[Kwnstantinos]

Re: VBA Excel find function for currency formatted cells - Please advise

See if this macro works for you...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub SelectNonZeroCurrencyCells()
  Dim C As Range, Addr As String
  Set C = ActiveCell.Offset(1)
  If Not C Is Nothing Then
    Addr = C.Address
    Do
      If C > 0 And AscW(Right(C.Text, 1)) = 8364 Then
        C.Select
        Exit Sub
      Else
        Set C = ActiveCell.EntireColumn.Find("*", C, xlValues, xlPart, , xlNext, , False)
      End If
    Loop While Not C Is Nothing And C.Address <> Addr
  End If
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Rick with your code i get Run-Time error "5" Invalid procedure call or argument

 

[Rick Rothstein]

Re: VBA Excel find function for currency formatted cells - Please advise

Rick with your code i get Run-Time error "5" Invalid procedure call or argument

On what line of code?

 

[Kwnstantinos]

Re: VBA Excel find function for currency formatted cells - Please advise

On what line of code?

If C > 0 And AscW(Right(C.Text, 1)) = 8364 Then <----here

 

[Rick Rothstein]

Re: VBA Excel find function for currency formatted cells - Please advise

If C > 0 And AscW(Right(C.Text, 1)) = 8364 Then <----here

See if this version of my macro works correctly for you...

[table="width: 500"]
[tr]
	[td]Sub SelectNonZeroCurrencyCells()
  Dim C As Range, Addr As String
  Set C = ActiveCell.Offset(1)
  If Not C Is Nothing Then
    Addr = C.Address
    Do
      If Val(C.Value) > 0 Then
        If AscW(Right(C.Text, 1)) = 8364 Then
          C.Select
          Exit Sub
        End If
      Else
        Set C = ActiveCell.EntireColumn.Find("*", C, xlValues, xlPart, , xlNext, , False)
      End If
    Loop While Not C Is Nothing And C.Address <> Addr
  End If
End Sub[/td]
[/tr]
[/table]