Find A Value Copy to Cell and replace Text

[Mpotten]

Hi All

I need to upgrade this macro that I have written using the Macro Record function.

The basics are that I wish to look up the text EUR in column G and every time if finds that value Copy across to the cell to the left in Column F and Delete the text EUR leaving just the numerical value. The next step is to delete the original cell insert the exchange value into the row on Column I and perform the calculation to give a dollar value in the starting cell in column G.

I have been successful with the calculations and the copying but currently it only works for a single cell and row not the whole data set.

here is the code

Sub Euro_Correction()'
' Euro_Correction Macro
'
' Keyboard Shortcut: Option+Cmd+Shift+E
'
    
    Columns("G:G").Select
    Selection.Find(What:="EUR", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
    Range("G36").Select
    Selection.Copy
    Range("F36").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Replace What:="EUR", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Cells.Find(What:="EUR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1]/RC[2])"
    Range("H36").Select
    ActiveCell.FormulaR1C1 = ""
    Range("I36").Select
    ActiveCell.FormulaR1C1 = "0.58026923"
End Sub

and here is a sample data set.

A	B	C	D	E	F	G	H	I	J
Co./Last Name	Date	Item Number	Qty	Desc.	Euro	Price	Total	Forex	SalesRep
cust 1	1/3/15	1234	1			$300		0
cust 1	1/3/15	1235	1			$400		0
cust 2	1/3/15	1236	2			$500		0
cust 2	1/3/15	1237	1			$600		0
cust 3	4/3/15	1234	3			EUR100		.58926
cust 3	4/3/15	1235	1			EUR200		.58926
cust 4	5/3/15	1236	1			EUR300		.58926
cust 4	5/3/15	1237	4			EUR300		.58926
cust 5	5/3/15	1238	2			$700		0

<tbody>
</tbody>

 

[DILIPandey]

Hi Mpotten,


As your have done it all, why don't you search internet for "VBA Loops" and update your code.


Regards,
DILIPandey

 

[Mpotten]

Thanks Dilipandey

I have just realised that i will also need to add in code so that i can get the macro to find the last cell with data to set the total range to work with.

I can use column A as this will always have uninterrupted data from the top of the Data set to the Bottom.

Range ("A2").select
selection.end(xldown).Select
LastRow = Selection.Row

 

[Rick Rothstein]

If I have understood your code correctly, the following macro should do what you want your code to do for every row. Of course, test it on a copy of your actual workbook while you determine that the code does, in fact, do what you intend it to.

Sub Euro_Correction() '
  [B][COLOR="#0000FF"]Const ConversionRate As Double = 0.58026923[/COLOR][/B]
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "G").End(xlUp).Row
  Range("F2:F" & LastRow) = Evaluate(Replace("IF(LEFT(G2:G#,3)=""EUR"",0+MID(G2:G#," & _
                            "4,99),IF(F2:F#="""","""",F2:F#))", "#", LastRow))
  With Range("F2:F" & LastRow).SpecialCells(xlConstants)
    .Offset(, 1).Formula = "=F" & .Row & "/I" & .Row
  End With
  Range("I2:I" & LastRow) = Evaluate(Replace("IF(LEN(F2:F#)," & _
                            ConversionRate & ",I2:I#)", "#", LastRow))
End Sub

Note that I put the conversion rate in a statement at the top of the code so you can find it more easily in case you have to change it later on. Also, verify that I handled this conversion factor correctly with respect to your existing data in case it does change in the future.

 

[Mpotten]

HI i know that this thread is now old and the above code has been working great for me.

I have now come across a small issue where this no longer works if when the code searches of "EUR" and does not find this string it causes the macro to report an error and not run. I have other sales that are in $ which still need to be addressed as part of the sales process.

 

[Rick Rothstein]

I have other sales that are in $ which still need to be addressed as part of the sales process.

How have you modified the code in order to do the $ values?

 

[Mpotten]

i have not replaced the or modified the code in any way

 

[Rick Rothstein]

i have not replaced the or modified the code in any way

We cannot see an image which is located on your computer. Help us this way... post a table of value where the code I posted in Message #4 fails (the quick test I did didn't fail).

 

[Mpotten]

so having the code work last moth it has now decided not to work again???

here is a copy of the raw data that I am working with

https://www.dropbox.com/s/72rjegvu7i651iw/Macro Problem.xlsm?dl=0