Results 1 to 3 of 3

Thread: [RESOLVED] How to copy only the different item in a group columns

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Feb 2004
    Location
    syria
    Posts
    854

    Resolved [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.

  2. #2

    Thread Starter
    Fanatic Member
    Join Date
    Feb 2004
    Location
    syria
    Posts
    854

    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

  3. #3
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Re: [RESOLVED] How to copy only the different item in a group columns

    One more way to do it...

    vb Code:
    1. Private Sub CommandButton1_Click()
    2.    
    3.     Count = 1
    4.    
    5.     'Replace 6 with the rownumber till where the data is
    6.     'For example if your range is A1:G500 then replace 6
    7.     'by 500 below
    8.    
    9.     For i = 1 To 6
    10.    
    11.         'Check if the data in the 1st 4 colums match
    12.         If Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("B" & i).Value And _
    13.         Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("C" & i).Value And _
    14.         Sheets("sheet1").Range("A" & i).Value = Sheets("sheet1").Range("D" & i).Value Then
    15.        
    16.         Else
    17.            
    18.             'Copy data
    19.             Sheets("Sheet1").Range("A" & i & ":" & "G" & i).Copy
    20.            
    21.             'Paste Data
    22.             Sheets("Sheet2").Range("A" & Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    23.             :=False, Transpose:=False
    24.            
    25.             'Reset Count
    26.             Count = Count + 1
    27.    
    28.         End If
    29.    
    30.     Next
    31. 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
  •  



Click Here to Expand Forum to Full Width