|
-
Feb 10th, 2008, 02:43 PM
#1
Thread Starter
Fanatic Member
[RESOLVED] How to copy only the different item in a group columns
Iwant a code to copy the items (any kind of item, number,text) in 7 columns (A,B,C,D,E,F,G,H) from sheet2 to sheet3. in condition if the items in first 4 columsn (A,B,C,D) are similar (match) to the columns in sheet3 it won't copy the items
it's mean :
if there are in sheet2 these item 1,1,1,1,3,4,5 it won't copy if there are these items in sheet3 1,1,1,1,8,9,1 because the first 4 colums are similar or match (1,1,1,1) , but if the items in sheet2 are 1,1,2,1,3,4,5 it will copy them because they different in first 4 columns (1,1,1,1 in sheet2 and 1,1,2,1 in sheet3).
A B C D E F G
--------------------------------------------------------------------------------------
1 1 1 1 8 9 1
1 1 2 1 3 4 5
1 1 1 3 3 4 5
1 1 1 1 8 7 2
1 1 1 1 3 4 5
1 1 2 1 3 4 5
After release the code it wil copy this items in sheet3
A B C D E F G
-----------------------------------------------------------------------------------
1 1 1 1 8 9 1
1 1 2 1 3 4 5
1 1 1 3 3 4 5
I hope I'm clear and thank you for help.
-
Feb 11th, 2008, 10:18 AM
#2
Thread Starter
Fanatic Member
Re: How to copy only the different item in a group columns
Here is the code
Dim myRange3 As Range
Dim R As Long
Dim cell As Range
Code:
For Each cell In myRange3
If IsError(Application.Match(cell.Value, Sheets("sheet3").Columns(1), 0)) _
Or IsError(Application.Match(cell.Offset(0, 1).Value, Sheets("sheet3").Columns(2), 0)) _
Or IsError(Application.Match(cell.Offset(0, 2).Value, Sheets("sheet3").Columns(3), 0)) _
Or IsError(Application.Match(cell.Offset(0, 3).Value, Sheets("sheet3").Columns(4), 0)) Then
R = Sheets("sheet3").UsedRange.Rows.Count
If R <> 1 Or Sheets("sheet3").Range("A1").Value <> "" Then R = R + 1
cell.Resize(, 8).Copy Sheets("sheet3").Range("a" & R)
End If
Next cell
-
Feb 11th, 2008, 10:42 AM
#3
Re: [RESOLVED] How to copy only the different item in a group columns
One more way to do it...
vb Code:
Private Sub CommandButton1_Click()
Count = 1
'Replace 6 with the rownumber till where the data is
'For example if your range is A1:G500 then replace 6
'by 500 below
For i = 1 To 6
'Check if the data in the 1st 4 colums match
If Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("B" & i).Value And _
Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("C" & i).Value And _
Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("D" & i).Value Then
Else
'Copy data
Sheets("Sheet1").Range("A" & i & ":" & "G" & i).Copy
'Paste Data
Sheets("Sheet2").Range("A" & Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Reset Count
Count = Count + 1
End If
Next
End Sub
A good exercise for the Heart is to bend down and help another up...
Please Mark your Thread " Resolved", if the query is solved
MyGear:
★ CPU ★ Ryzen 5 5800X
★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
★ Keyboard ★ TVS Electronics Gold Keyboard
★ Mouse ★ Logitech G502 Hero
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|