Macro To Copy Unique Data

[Dazzawm]

I have a lot of rows and columns on sheet1 with various data. What I need the macro to do is look at column 'H' then column 'G'. As you can see rows 1-4 and 6-7 have the same data in column 'H' but a choice of Manual or Automatic in column 'G'. I want just the ones with Automatic only (not all rows with automatic in) copied onto sheet 2, like rows 5 and 8. Thanks.


Sheet1

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 67px"><COL style="WIDTH: 67px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt"><TD> </TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD><TD>J</TD><TD>K</TD><TD>L</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">MANUAL</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS4_43A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">MANUAL</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS4_43A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS4_43A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS4_43A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">LSGS4_35A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS5_35A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">MANUAL</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-SIZE: 8pt">LSGS5_35A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">LSGS5_35D</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR></TBODY></TABLE>

Sheet2

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 67px"><COL style="WIDTH: 67px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"><COL style="WIDTH: 86px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt"><TD> </TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD><TD>J</TD><TD>K</TD><TD>L</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">LSGS4_35A</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">AUTOMATIC</TD><TD style="BACKGROUND-COLOR: #99cc00; FONT-SIZE: 8pt">LSGS5_35D</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD><TD style="FONT-SIZE: 8pt">VARIOUS DATA</TD></TR></TBODY></TABLE>

 

[Dazzawm]

^

 

[Dazzawm]

I may need to explain myself more clearly what I need. Please look at my most recent table ^. In column H are codes to 1000s and 1000s of various vehicles (about 55000 rows), each vehicle/model has a different code in 'H' the ones highlighted in yellow are when the models were built both as manual and automatic. What I need are the models that were just made as an automatic (the ones in green) copied over onto sheet 2. There may be several rows that look the same but that is where there is different data in other cells - 'various data' which doesn't matter. If you look at rows 1-4 LSGS4_43A in 'H' is one model vehicle but to the left there are 2 rows as manual and 2 rows as automatic, so these need to be ignored. If you look at rows 5-10 LSGS4_35A is another model but to the left it is only automatic and no manual, so these (or only 1 row) need to be copied over to sheet 2.

I hope I am a bit clearer with my requirements now.

 

[Johnny C]

Hi Darren
It's easier than you think I suspect... if you just want rows with Automatic copied in, just filter on that column and choose Automatic. Then copy the data to the new sheet, and only those visible rows will be copied.
To do this in VBA:
This only works on a true data sheet, where you copy/pasted into A1, i.e. There are no blank columns or rows within the data.
First, define a couple of dynamic ranges. If you don't know what they are, a rangename as well as referring to a fixed raneg can refer to a range defined by a function. Look up the OFFSET function - it's very very useful. You want the 5 parameter version here OFFSET(Anchor cell, rows down, cells right, height of range, width of range). What this does is identify a range relative to a cell (A1 in the example), starting 0 orws down and 0 columns across (i.e. same cell), then specifies a block X rows and Y cols. X and Y found with the COUNTA function.

1 Go into the Formulas ribbon, Name Manager, New.
Enter a rangename (Titles in the example), then in the refers to box, put this:
=OFFSET(Sheet1!$A$1,0,0,1,COUNTA(Sheet1!$A$1:$N$1))
Change the N1 ref to as far to the right as you want, but make sure there's no blanks in row 1 to the end of your data.
2 Go into the Formulas ribbon, Name Manager, New.
Enter a rangename (Data in the example), then in the Refers To box, put this:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A$1:$A$10000),COUNTA(Sheet1!$A$1:$N$1))
Change the A10000 ref to as far down as you're lieky to need, but make sure there's no blanks in Col A to the end of your data.
Now, add this code to your workbook

Sub FilterAutomatic()
'
' Filter on Automatic and copy to sheet2
'
ActiveSheet.Range("Titles").AutoFilter
ActiveSheet.Range("Data").AutoFilter Field:=7, Criteria1:="Automatic"
ActiveSheet.Range("Data").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

 
End Sub

Now, add a button to sheet1 (Developer Tab, Insert, on the Form options choose the first option (button). Assign the button to FilterAutomatic in this workbook. To change the name on the button, right click button to show handles, then left-click over text in button and delete/backspace and add new text.

 

[Dazzawm]

Problem is if I sort by automatic and copy over there will be models included where a manual was built as well lower down. I need to copy over only models made as an automatic.

 

[Johnny C]

Easy enough. You just need a couple of COUNTIFS (since you've got XL2007) in the first blank column.

This works, say your data goes up to row 2,000: on row 8,

=COUNTIFS($H$2:$H7,$H8,$G$2:$G7,"Manual")+COUNTIFS($H9:$H$2001,$H8,$G9:$G$2001,"Manual")

What this does is count the number of rows where you have both the model number of the row (col H) AND "Manual" in col G in the same row. There are 2 countifs as you look above and below.

Then copy up and down the entire column. it might not work on the first row, check, you'd need to delete the first COUNTIFS.

Then filter on that column, looking for where the value returned is 0.

Change your macro to the new column (replace the column number 7 with the new column number) , and specify '0' instead of automatic.

 

[Johnny C]

Actually, this is easier:

on row 2 (if your data has <= 2000 rows, change that if you need to)
=COUNTIFS($H$2:$H$2000,$H2,$G$2:$G$2000,"Manual")

and just filter on '0' in that column.

 

[Dazzawm]

This is going well over my head now and starting to confuse me! I have a blank column 'I' please tell me what formula to put in I2 and copy down. Thanks

 

[ColinKJ]

Hi Darren,

A macro solution if you want it.

A), it assums you have a Header Row in 1
B), it assums you don't want to copy over any model that also has a Manual.
C), it assums that where a model only has Automatic, it copies over all appropriate rows.

Sub CopyAutomaticsOnly()

[FONT=Verdana][COLOR=black]Sheets("Sheet1").Activate[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Cells.Select[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Application.CutCopyMode = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       DataOption1:=xlSortNormal[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlGuess, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       DataOption1:=xlSortNormal[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]R = Range("H" & Rows.Count).End(xlUp).Row[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]For a = 2 To R[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]If Cells(a, 7) = "AUTOMATIC" Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]x = Cells(a, 8)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]For b = a + 1 To R[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]If Cells(b, 8) = x And Cells(b, 7) = "MANUAL" Then GoTo nexta[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Next b[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Rows(a & ":" & a).Copy[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Sheets("Sheet2").Activate[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]RR = Range("A" & Rows.Count).End(xlUp).Row + 1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Cells(RR, 1).Select[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ActiveSheet.Paste[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Sheets("Sheet1").Activate[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]nexta:[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Next a[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]

I've done an example WB called AutomaticOnly which you can download from:

http://www.box.net/shared/rr9f185cm2

Ctrl+q activates the macro.

Regards

ColinKJ

 

[Johnny C]

This is going well over my head now and starting to confuse me! I have a blank column 'I' please tell me what formula to put in I2 and copy down. Thanks

=COUNTIFS($H$2:$H$2000,$H2,$G$2:$G$2000,"Manual")

 

[Krishnakumar]

Hi,

Try

Sub kTest()
    
    Dim k(), ka, i As Long, n As Long
    Dim dic As Object, d
    
    'Adjust to suit
    Const DestRange     As String = "K2"
    Const DataRange     As String = "A:I"
    Const LookupRange   As String = "G:H"
    Const Col1          As Long = 7 '<<===AUTOMATIC/MANUAL Column
    Const Col2          As Long = 8 '<<=== Other Column
    
    
    ka = Application.Intersect(ActiveSheet.UsedRange, Columns(DataRange))
    d = Application.Intersect(ActiveSheet.UsedRange, Columns(LookupRange))
    
    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1
    For i = 1 To UBound(d, 1)
        If Len(d(i, 1)) Then
            If InStr(1, dic.Item(d(i, 2)), d(i, 1), 1) = 0 Then
                dic.Item(d(i, 2)) = IIf(Len(dic.Item(d(i, 2))), dic.Item(d(i, 2)) & d(i, 1), d(i, 1))
            End If
        End If
    Next
    
    ReDim k(1 To UBound(ka, 1), 1 To 2)
    
    For i = 1 To UBound(ka, 1)
        If dic.exists(ka(i, Col2)) Then
            If LCase$(dic.Item(ka(i, Col2))) = "automatic" Then
                n = n + 1
                k(n, 1) = ka(i, Col1): k(n, 2) = ka(i, Col2)
            End If
        End If
    Next
    If n Then
        With Range(DestRange)
            .Resize(n, 2).Value = k
        End With
    End If
    
End Sub