PDA

View Full Version : Solved: Copy Data of duplicate item to first sheet .



parscon
08-14-2012, 04:05 PM
thats my Final Request . hope all of you pardon me .

I need another VBA code if find duplicate copy the data (row)to sheet 1
That mean, I have data on column A like 23456 and also Ihave the same on column A on sheet 2

When run VBA copy the data of on column B-C-D-E-H on sheet 2 to sheet 1
Example : on Sheet 1 on Column A we have :



Column A
234567



on Sheet 2 we have these data



Column A Column B Column C ColumnD ColumnE Column H

234567 DATA-1 DATA-2 DATA-3 DATA-4 DATA-5



When run VBA in Sheet1 Column A : copy the data from sheet 2 to this sheet.



Column A Column B Column C ColumnD ColumnE Column H

234567 DATA-1 DATA-2 DATA-3 DATA-4 DATA-5

Zack Barresse
08-14-2012, 05:10 PM
Hi there,

Why do you need VBA for this? Why not just use VLOOKUP?

=VLOOKUP($A2,Sheet2!$A:$A,COLUMN(B$1),0)

This assumes you are putting the formula in Sheet1 in B2. Copy across to the right, then down as needed.

HTH

parscon
08-14-2012, 10:04 PM
it is not work and also i need a VBA for this , :(

Please test in a sample file .



I found VBA but it is for 2 workbook , i need this for 2 sheet and also this code will search all sheet but i need search just 1 sheet . Please help me .

Sub PNCHECKER()
Dim i As Long
Dim Parts As Worksheet
Dim Numbers As Worksheet
Dim F_Rng As Range
Dim T_Str As String
Dim L_Rw As Long

Set Parts = ThisWorkbook.Sheets("Sheet1")

With Parts
L_Rw = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To L_Rw
T_Str = .Cells(i, 1).Value
For Each Numbers In Workbooks("Numbers").Sheets

With Numbers

Set F_Rng = .Range("a:a").Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing Then
F_Rng.Offset(, 1).Resize(, 4).Copy Parts.Cells(i, 2)
Exit For
End If
End With
Next
Next i
End With

Set F_Rng = Nothing
Set Numbers = Nothing
Set Parts = Nothing

End Sub

parscon
08-15-2012, 03:11 AM
I found some thing but need some help to complete this .

1- there is a range but i want check all data on column A not A1:A5 for both sheet .

Please help me .



Sub moving()
Dim c As Range, d As Range
Worksheets("Sheet2").Activate
For Each c In Range("A1:A15")
For Each d In Worksheets("Sheet1").Range("A1:A4")
If c = d Then
c.Resize(1, 4).Copy Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next
End Sub

parscon
08-15-2012, 05:23 AM
Please some body help me . now i changed Sheet1 Range to A1:A65 but i have 64 row and when run this code excel will be freezed but when change to 64 it is work , i have problem because i can not change the number manualy so need select auto.

How can do it . HELP HELP Please




Sub moving()
Dim c As Range, d As Range
Worksheets("Sheet2").Activate
For Each c In Range("A1:A65536")
For Each d In Worksheets("Sheet1").Range("A1:A65")
If c = d Then
c.Resize(1, 4).Copy Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next
End Sub

Bob Phillips
08-15-2012, 05:42 AM
Untested

Sub moving()
Dim idx As Long

For Each d In Worksheets("Sheet1").Range("A1:A65")

idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then

Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next i
End Sub

parscon
08-15-2012, 05:59 AM
Dear Xld

Invalid or unqualified refrence and when click ok select .Rows



Worksheets("Sheet3").Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)

Bob Phillips
08-15-2012, 06:21 AM
Said it was untested!

Sub moving()
Dim idx As Long

For Each d In Worksheets("Sheet1").Range("A1:A65")

idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error Goto 0
If idx > 0 Then

Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next i
End Sub

parscon
08-15-2012, 06:24 AM
Dear , Xld ,

i never blamed you , It is your kind that you help peoples.

again the same error but end of code i of Next .

i removed i and code work .

Thank you again .

Bob Phillips
08-15-2012, 07:27 AM
That should be Next d, and the d shoule be Dimensioned of course.

My bad :(

parscon
08-15-2012, 08:46 AM
Dear Xld , is it true now ?



Sub moving()
Dim idx As Long

For Each d In Worksheets("Sheet1").Range("A1:A65")

idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then

Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub

Zack Barresse
08-15-2012, 06:37 PM
Don't you want to offset it to column B, and go 5 columns? If so, make a slight adjustment...

Sub moving()
Dim idx As Long
Dim d As range
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error Goto 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 2).Resize(1, 5).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub

parscon
08-15-2012, 11:52 PM
Dear Zack Barresse
Hope so you are fine and thank you for your big help .
just i have a question , is there any way to copy the data on same sheet that mean sheet 1 and start from column B ? like my sample in top of topic .

Thank you very much .

BigDawg15
08-16-2012, 08:39 AM
Parscon,

Try this. Slight modification to Zack Barresse's Code.

Sub moving()
Dim idx As Long

For Each d In Worksheets("Sheet1").Range("A1:A65")

idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then

Worksheets("Sheet2").Cells(idx, 1).Resize(1, 6).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub


BigDawg15