Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy paste and addition by vba

Status
Not open for further replies.

rider1234

Programmer
Jun 21, 2019
51
IN
Vba is placed in a seperate file
open 1.xls files
open PL.xlsx file
all files are located in same path
If column E of 1.xls matches with column A of PL.xlsx and column B of PL.xlsx is blank then copy and paste the column R data of 1.xls to column B of PL.xlsx
Or
If column E of 1.xls matches with column A of PL.xlsx and column B of PL.xlsx has some data (value) then add column R data of 1.xls to column B of PL.xlsx
save the changes made to PL.xlsx
save and close all the workbooks

example
if column B of Pl.xlsx contains -5 and column R of 1.xls contains 4 then in column B of PL.xlsx the data will be -1
if column B of Pl.xlsx contains -5 and column R of 1.xls contains -6 then in column B of PL.xlsx the data will be -11
if column B of Pl.xlsx contains 5 and column R of 1.xls contains -6 then in column B of PL.xlsx the data will be -1


 
Tek-Tips is not a free coding service. I have given you code that you can adapt. I am trying to help you do that but you are unwilling to help yourself.

Therefore, that is all I am willing to do for you.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
 
rider1234 said:
I have to do this by vba so plz guide
My first last priority would be vba
i am new to vba
i am not a professional vba code writer
i am confused what to do with that

It looks to me that either:
[ul]
[li]You are a student who wants to learn VBA in Excel. If so, this is not really the forum for you. People here do not ‘teach’, they rather help others who already know the subject. And if you do want to learn, your approach is wrong – you should start with something a LOT simpler to learn the basics first.[/li]
[li]You were assigned a task (at work?) that is WAY above your head. If that’s the case, even if you write a working code without knowing what you wrote, it is dangerous because any changes or modifications to this code run the risk of giving you wrong outcome. And that’s not good at work, or in any other environment.[/li]
[/ul]


---- Andy

There is a great need for a sarcasm font.
 
I am a student i dont know anything about vba but seein some samples i have learned vba thats y i can write something by vba and i have already mentioned that i know
by seeing some sample and by seeing some complicated samples i will try to learn from that code
it will be a great opportunity for me to learn and see the vba code samples from a professional vba programmer sir u r seniors and i am a fresher so it will be a great guidance from u
sir plz provide the solution of the same and i promise that next time when i ask the question u will see the improvement in me
 
Sorry. NOW is the time to begin, grasshopper.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
i am not as smart as u tried sir but i unable to write a code but next time
I will provide u 75% of the code and i will ask for 25% of guidance from u sir
 
I'm waiting...

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
Okay, here is your is the entire procedure that you picked to be the template.

Let me lead you, one step at a time.

So what would you need to change in this one line of [tt]For...Next[/tt] code to make it do what you need to happen?
Code:
[COLOR=#BABDB6]Sub Code()
Dim wbk1 As Workbook
Dim wish As Worksheet
Dim wbk2 As Workbook
Dim wsh2 As Worksheet
Dim r1 As Range, vRow2 As Variant, sLookup As String
Dim wbk3 As Workbook, wsh3 As Worksheet, lRow3 As Long
Dim lLastRow As Long

Application.ScreenUpdating = False

Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
Set wsh1 = wbk1.Worksheets(1)

Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
Set wsh2 = wbk2.Worksheets(1)

With wsh1
      lLastRow = .UsedRange.Rows.Count[/color]
      For Each r1 In .Range(.Cells(2, "M"), .Cells(lLastRow, "M"))
         [COLOR=#BABDB6]If r1.Value > 0 Then
            sLookup = .Cells(r1.Row, "V").Value
            vRow2 = Application.Match(sLookup, wsh2.Range("F:F"), 0)
            If IsError(vRow2) Then
               lRow3 = lRow3 + 1
               wsh3.Cells(lRow3, 1).Value = sLookup
            End If
         End If
      [COLOR=#000000]Next[/color]
   End With

   Application.DisplayAlerts = False
   wbk1.Close SaveChanges:=True
   wbk2.Close SaveChanges:=True
   Application.DisplayAlerts = True

   Application.ScreenUpdating = True
End Sub[/color]

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
Sub Code()
Dim wbk1 As Workbook
Dim wish As Worksheet
Dim wbk2 As Workbook
Dim wsh2 As Worksheet
Dim r1 As Range, vRow2 As Variant, sLookup As String
Dim wbk3 As Workbook, wsh3 As Worksheet, lRow3 As Long
Dim lLastRow As Long

Application.ScreenUpdating = False

Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
Set wsh1 = wbk1.Worksheets(1)

Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
Set wsh2 = wbk2.Worksheets(1)

With wsh1
lLastRow = .UsedRange.Rows.Count
For Each r1 In .Range(.Cells(2, "B"), .Cells(lLastRow, "B"))
If r1.Value > 0 Then
sLookup = .Cells(r1.Row, "E").Value
vRow2 = Application.Match(sLookup, wsh2.Range("A:A"), 0)
If IsError(vRow2) Then
lRow3 = lRow3 + 1
wsh3.Cells(lRow3, 1).Value = sLookup
End If
End If
Next
End With

Application.DisplayAlerts = False
wbk1.Close SaveChanges:=True
wbk2.Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True
End Sub







Am i right Sir
 
If column E of 1.xls matches with column A of PL.xlsx and column B of PL.xlsx is blank then copy and paste the column R data of 1.xls to column B of PL.xlsx

Well, you made some good progress! But I have a question. Why are you looking at each value in column B in 1.xls?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
for copy and paste the data and calculation of the data
if it is a blank then simply copy and paste
if present then calculate and paste the result
if present then plz see the example for understanding purpose i have mentioned in this post
 
rider1234 - do you see how your code shows up in your posts?
Do you see Skip'd code in his posts?

Please learn how to use TGML tags - highlight the text in your post that is [tt]code[/tt] and click on the icon to display your code as Skip does. Use Preview button before you Submit your post.

CODE_bny0op.png



---- Andy

There is a great need for a sarcasm font.
 
Sorry Sir i understood my mistake in future it will not be repeated
 
Please focus on the question at hand. I asked you...
Why are you looking at each value in column B in 1.xls?
and your reply was totally unrelated.

Please answer this question.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
that if there is a data in column B then add or subtract it depends on the data
 
I'm sorry. If you can't understand this quite elementary issue, I cannot help you because you just do not understand some very elementary reasoning and logic.

Good bye.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
I will give you a hint. Use the solution in thread707-1795470.

Make minor changes to the statements that start with
[pre]
Starting with Purpose for change

Set wbk2 = To open the correct workbook
For Each r1 To traverse the column with the lookup data
If r1.Value To assure that the reference has a string value
sLookup = To assign the proper lookup value
vRow2 = NO CHANGE REQUIRED
If Not NO CHANGE REQUIRED
wsh2.Rows(vRow2) When you get to this statement, you will need additional help
[/pre]
If you can't make the very minor changes in 4 statements, then I won't provide any subsequent help. Any ordinary person with motivation, ought to be able to figure out by looking at the requirements stated in that thread, how the corresponding code is written and then applying that knowledge to this thread's requirements.

I've made it extremely easy for you to to tackle this change with several specific tips.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
Code:
Sub Code()
    Dim wbk1 As Workbook
    Dim wsh1 As Worksheet
    Dim wbk2 As Workbook
    Dim wsh2 As Worksheet
    Dim r1 As Range, vRow2 As Variant, sLookup As String
    
    Application.ScreenUpdating = False
    
    Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
    Set wsh1 = wbk1.Worksheets(1)
    
    Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
    Set wsh2 = wbk2.Worksheets(1)
    
    With wsh1
        For Each r1 In .Range(.Cells(2, "E"), .Cells(2, "E").End(xlDown))
                sLookup = .Cells(r1.Row, "E").Value
                vRow2 = Application.Match(sLookup, wsh2.Range("A:A"), 0)
                If r1.Value > 0 Then
                If Not IsError(vRow2) Then _
                    wsh2.Rows(vRow2).
            End If
        Next
    End With
    
    Application.DisplayAlerts = False
    wbk1.Close SaveChanges:=True
    wbk2.Close SaveChanges:=True
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
End Sub




Plz have a look sir
 
Yes!
Code:
Sub Code()
    Dim wbk1 As Workbook
    Dim wsh1 As Worksheet
    Dim wbk2 As Workbook
    Dim wsh2 As Worksheet
    Dim r1 As Range, vRow2 As Variant, sLookup As String
    
    Application.ScreenUpdating = False
    
    Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
    Set wsh1 = wbk1.Worksheets(1)
    
    Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
    Set wsh2 = wbk2.Worksheets(1)
    
    With wsh1
        For Each r1 In .Range(.Cells(2, "E"), .Cells(2, "E").End(xlDown))
            sLookup = .Cells(r1.Row, "E").Value
            vRow2 = Application.Match(sLookup, wsh2.Range("A:A"), 0)
                
            If Not IsError(vRow2) Then 
                wsh2.Cells(vRow2, "B").Value = wsh2.Cells(vRow2, "B").Value + wsh1.Cells(r1.Row, "R").Value
            End If
        Next
    End With
    
    Application.DisplayAlerts = False
    wbk1.Close SaveChanges:=True
    wbk2.Close SaveChanges:=True
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
End Sub

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
AD1D550E-FCB5-4AB6-A3C8-1F86CACE2554_ne1bcz.jpg
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top