On Jun 30, 6:44*am, "PY & Associates" <cheung.kc...@gmail.com> wrote:
> On Jun 29, 9:19*pm, nannon8 <nann...@lycos.co.uk> wrote:
>
>
>
>
>
> > I have a spreadsheet with various pieces of data. *Each value will be
> > repeated at least once in the sheet. *I would like to use a macro that
> > will look thorugh the rows of a specific column, and copy the entire
> > row if it the data appears more than three times. *Could anyone help
> > me with this?
>
> > For example, in the following all rows for credential 2, 3, and 5
> > should be copied onto a new sheet.
>
> > timestamp
> > 24/05/10 23:54:39 * * * Valid credential 1
> > 24/05/10 23:37:04 * * * Valid credential 2
> > 24/05/10 23:27:03 * * * Valid credential 3
> > 24/05/10 23:26:59 * * * Valid credential 4
> > 24/05/10 23:26:55 * * * Valid credential 2
> > 24/05/10 23:18:10 * * * Valid credential 1
> > 24/05/10 23:15:42 * * * Valid credential 2
> > 24/05/10 23:14:11 * * * Valid credential 3
> > 24/05/10 23:09:18 * * * Valid credential 4
> > 24/05/10 23:02:47 * * * Valid credential 4
> > 24/05/10 23:02:42 * * * Valid credential 3
> > 24/05/10 22:38:59 * * * Valid credential 5
> > 24/05/10 22:38:33 * * * Valid credential 1
> > 24/05/10 22:38:31 * * * Valid credential 5
> > 24/05/10 22:38:29 * * * Valid credential 2
> > 24/05/10 22:38:27 * * * Valid credential 5
> > 24/05/10 22:33:39 * * * Valid credential 3
> > 24/05/10 22:31:35 * * * Valid credential 5
> > 24/05/10 22:31:33 * * * Valid credential 5
>
> Split the line into columns A and B.
> in C1=COUNTIF($B$1:$B$19,B1)
> copy down
> you get 3, 4,4,3, 4,3, *4,4,3,3,4, 5,3,5, * * * 4,5, * *4,5, * *5
> sort column C- Hide quoted text -
>
> - Show quoted text -
This macro should do it from the active sheet
Option Explicit
Sub SAS_ListIfUniqueCount() 'change ds to suit
Dim lr As Long
Dim c As Range
Dim r As Long
Dim ds As Worksheet
Set ds = Sheets("sheet19")
lr = Cells(Rows.Count, 1).End(xlUp).Row
With Range("B1:B" & lr)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
r = 1
For Each c In .Offset(1).SpecialCells(xlCellTypeVisible)
If Application.CountIf(.Offset(1), c) > 3 Then
Cells(c.Row, 1).Resize(, 2).Copy ds.Cells(r, 1)
r = r + 1
End If
Next c
End With
ActiveSheet.ShowAllData
End Sub
|
Similar Threads
