Copy and Paste based on comparisons/Match and calculations of cells in two workbooks

[DocAElstein]

This is a similar , shortened version of the question here: ( http://www.excelfox.com/forum/showth...centage-by-vba )

---

file name is sample1.xlsx
compare column O is greater or column P is greater
if column O is greater then calculate the 0.50% of column O and after getting the 0.50% of column O multiply the same with column L and paste the result in column Y
and if column P is greater then calculate the 0.50% of column P and after getting the 0.50% of column P multiply the same with column L and paste the result in column Y
save the changes and close the file

Example

Before:
_____ Workbook: sample1.xlsx ( Using Excel 2007 32 bit )

Row\Col	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1		Column L			Column O	Column P									Column Y
2		3			1	3
3		3			2	2
4		3			3	1
5

Worksheet: Tabelle1


After running routine, Sub Vixer2()
_____ Workbook: sample1.xlsx ( Using Excel 2007 32 bit )

Row\Col	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1		Column L			Column O	Column P									Column Y
2		3			1	3									0.045
3		3			2	2									0.03
4		3			3	1									0.045
5

Worksheet: Tabelle1

' Option Explicit
' file name is sample1.xlsx
' compare column O is greater or column P is greater
' if column O is greater then calculate the 0.50% of column O and after getting the 0.50% of column O multiply the same with column L and paste the result in column Y
' if column P is greater then calculate the 0.50% of column P and after getting the 0.50% of column P multiply the same with column L and paste the result in column Y
' save the changes and close the file
'
Sub Vixer2() ' http://www.excelfox.com/forum/showthread.php/2352-calculation-and-multiply-by-vba
Rem 1 Workbook and worksheets info
Dim Wb1 As Workbook: Set Wb1 = Workbooks("sample1.xlsx") ' Set using workbooks collection object of open files
Dim Ws1 As Worksheet: Set Ws1 = Wb1.Worksheets.Item(1) ' First worksheet, (as worksheet object) in open file "sample1.xlsx"
Dim Lr1 As Long, Lr2 As Long
 Let Lr1 = 4: Lr2 = 4 ' For this example I am using just three rows of data, and a header

Rem 3 Main Loop for all data rows
Dim Cnt As Long ' Main Loop for all data rows ================================================
    ' 3a)(i) ' compare column O is greater or column P is greater
    For Cnt = 2 To Lr1
    Dim Bigger As Double
        If Ws1.Range("O" & Cnt & "").Value > Ws1.Range("P" & Cnt & "").Value Then ' if column O is greater
         Let Bigger = Ws1.Range("O" & Cnt & "").Value
        Else
         Let Bigger = Ws1.Range("P" & Cnt & "").Value ' if column P is greater
        End If
    '3a)(ii) calculate the 0.50% of that and multiply the same with column L
    Dim Rslt As Double '
     Let Rslt = Bigger * (0.5 / 100) * Ws1.Range("L" & Cnt & "").Value ' calculate the 0.50% of that and multiply the same with column L
    '3b) paste the result to sample1.xlsx column Y
     Let Ws1.Range("Y" & Cnt & "").Value = Rslt
    Next Cnt '     Main Loop for all rows =====================================================

Rem 4 save the changes and close the file
 Wb1.Close savechanges:=True
End Sub

Alan