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

[fixer]

I met with an error while runing the code
error name - run time error 9 subscript out of range
highlighted line : Set Wb1 = Workbooks("ap.xls") ' Set using workbooks collection object of open files

[DocAElstein]

I do not have that code line in the macro that I gave you.

[p45cal]

I met with an error while runing the code
error name - run time error 9 subscript out of range
highlighted line : Set Wb1 = Workbooks("ap.xls") ' Set using workbooks collection object of open files

This can only mean that you've got the file name wrong OR that that file is not currently an open file.

[fixer]

both files aren't opened so plz guide sir

[p45cal]

both files aren't opened so plz guide sir

then open them!

[fixer]

Sir but i need the code should open all that file and after the process completed it should close that file

[DocAElstein]

For example….

Workbooks.Open Filename:="C:\...____.\..___...\sample1.xlsx"
Or
Workbooks.Open "C:\...____.\..___...\sample1.xlsx"
Or as in the given macro , change to

Rem 1 Workbook and worksheets info
Dim Wb1 As Workbook: Set Wb1 = Workbooks.Open("C:\...____.\..___...\sample1.xlsx")

Ref:
https://de.lmgtfy.com/?q=vba+open+workbook
https://docs.microsoft.com/en-us/off...workbooks.open
https://www.youtube.com/watch?v=Vau4VrBwrHg

[fixer]

Sir there is one more issue in the code so plz have a look
i am attaching the file and the code

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/showth...ultiply-by-vba
'1a) Workbook and worksheets info
Dim Wb1 As Workbook: Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\ap.xls") ' 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
Dim Cnt As Long ' Main Loop for all data rows ================================================
    ' 3a) ' 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
    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 =====================================================
' save the changes and close the file
 Wb1.Close savechanges:=True
End Sub

[DocAElstein]

there is one more issue in the code

What is the issue??

---

.....so plz have a look
i am attaching the file and the code

I took a look here: http://www.excelfox.com/forum/showth...ll=1#post11417


Alan