Find repeating numbers then copy certain cells of same row to another sheet

[xjpx]

Hi all, I am in need of some help. I am trying to loop through column 'N' to find for numbers that are repeated 3 times or more. Once found all these number, paste the numbers into Sheet 2 along with some other cells in the same rows. Below I have attached some images with more explanation to better elaborate.
Firstly, search column 'M', if it is 'OUT' data in column 'N' is taken into account if it is 'IN' data in column 'N' does not need to be counted. Next, loop through column 'N' and find numbers that are repeated more than 3 times. So for the image below, only number 7890 needs to be considered as repeating 3 times as it had 3 OUTs. Dont have to consider IN 7890, in this case 7890 appears 3 times.

Next, information from columns A, C, D, I and L also have to be copied into the other sheet, Sheet 2.

The final product is exactly as seen below in Sheet 2. Column A is just running numbers as more Numbers matches the conditions above.

Seems really confusing to me... I hope I have done a good job explaining. I have tried running some scripts but I have problems matching both conditions of OUT and >= 3 repeats.

Thanks!

 

[bebo021999]

Do you refer to worksheet formula or VBA?

 

[bebo021999]

Also, is helper column (i.e, column O2:O10) allowed?

 

[xjpx]

Also, is helper column (i.e, column O2:O10) allowed?

Do you refer to worksheet formula or VBA?

Hello bebo021999, I think VBA would suit better but im open to looking at worksheet formula to see if it functions the same. Helper column can be used in Sheet 1 P2 onwards,

 

[bebo021999]

Could you post a mini sheet via XL2BB : XL2BB - Excel Range to BBCode
so the helpers do not have to re type the data
?

 

[xjpx]

Could you post a mini sheet via XL2BB : XL2BB - Excel Range to BBCode
so the helpers do not have to re type the data
?

Sheet 1

Test.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Year		Month	Date					Data 1			Data 2	Action	Number
2	1999		Jan	6					A			J	IN	123456
3	1999		Jan	7					B			K	OUT	7890
4	1999		Feb	8					C			L	OUT	7890
5	1999		Feb	15					D			M	IN	12345
6	1999		Mar	12					E			N	OUT	123456
7	2000		Jan	1					F			O	IN	7890
8	2000		Apr	2					G			P	OUT	7890
9	2000		May	17					H			Q	OUT	12345
10	2000		May	22					I			R	OUT	12345
Sheet1

Sheet 2

Test.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3	No.	Number		Date	Data 2	Data 1			Date	Data 2	Data1			Date	Data 2	Data1
4	1	7890		7/1/1999	K	B			8/2/1999	L	C			2/4/2000	P	G
Sheet2

Wow this is amazing! So sorry I didn't know about this.

 

[xjpx]

Could you post a mini sheet via XL2BB : XL2BB - Excel Range to BBCode
so the helpers do not have to re type the data
?

Hello @bebo021999 is the data provided sufficient? Do you require more information? Please let me know! Thanks!

 

[bebo021999]

Hello, sorry for late reply.
Alt-F11 to open VBA window, insert module, then paste below code to:

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, max&, count&
Dim rng, s, r As String, cell As Range, dic As Object, arr()
Set dic = CreateObject("Scripting.dictionary")
Worksheets("Sheet1").Activate
lr = Cells(Rows.count, "A").End(xlUp).Row
rng = Range("A2:N" & lr).Value
    For Each cell In Range("N2:N" & lr)
        count = WorksheetFunction.CountIfs(Range("M2:M" & lr), "OUT", Range("N2:N" & lr), cell.Value) ' count "OUT"'s of specific number
        If count > max Then max = count ' get the maximum "OUT" within numbers
        If cell.Offset(, -1).Value = "OUT" And count > 2 Then 'loop through each number with "OUT">=3, then write "number" and "row number" into dictionary
            If Not dic.exists(cell.Value) Then
                k = k + 1
                r = count & "," & cell.Row - 1
                dic.Add cell.Value, r
            Else
                r = r & "," & cell.Row - 1
                dic(cell.Value) = r
            End If
        End If
    Next
    k = 0
    ReDim arr(1 To dic.count, 1 To max * 5 + 1) ' create variable array
Worksheets("Sheet2").Activate
    Range("A3:B3").Value = Array("No.", "Number")
    For Each key In dic.keys
        k = k + 1
        s = Split(dic(key), ",")
        For j = 1 To max * 5 + 1
            arr(k, 1) = k
            arr(k, 2) = key
            For i = 1 To UBound(s)
                Range(Cells(3, i * 5 - 1), Cells(3, i * 5 + 1)).Value = Array("Date", "Data 2", "Data 1")
                arr(k, i * 5 - 1) = rng(s(i), 4) & "/" & rng(s(i), 3) & "/" & rng(s(i), 1)
                arr(k, i * 5) = rng(s(i), 12)
                arr(k, i * 5 + 1) = rng(s(i), 9)
            Next
        Next
    Next
Range("A4").Resize(k, max * 5 + 1).Value = arr
End Sub

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Year		Month	Date					Data 1			Data 2	Action	Number
2	1999		Jan	6					A			J	IN	123456
3	1999		Jan	7					B			K	OUT	7890
4	1999		Feb	8					C			L	OUT	7890
5	1999		Feb	15					D			M	IN	12345
6	1999		Mar	12					E			N	OUT	123456
7	2000		Jan	1					F			O	IN	7890
8	2000		Apr	2					G			P	OUT	7890
9	2000		May	17					H			Q	OUT	12345
10	2000		May	22					I			R	OUT	12345
11	2000		May	22					I			R	OUT	12345
12	2000		May	22					I			R	OUT	12345
Sheet1

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1
2
3	No.	Number		Date	Data 2	Data 1			Date	Data 2	Data 1			Date	Data 2	Data 1			Date	Data 2	Data 1
4	1	7890		07/01/1999	K	B			08/02/1999	L	C			02/04/2000	P	G
5	2	12345		17/05/2000	Q	H			22/05/2000	R	I			22/05/2000	R	I			22/05/2000	R	I
Sheet2

 

[xjpx]

Hello, sorry for late reply.
Alt-F11 to open VBA window, insert module, then paste below code to:

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, max&, count&
Dim rng, s, r As String, cell As Range, dic As Object, arr()
Set dic = CreateObject("Scripting.dictionary")
Worksheets("Sheet1").Activate
lr = Cells(Rows.count, "A").End(xlUp).Row
rng = Range("A2:N" & lr).Value
    For Each cell In Range("N2:N" & lr)
        count = WorksheetFunction.CountIfs(Range("M2:M" & lr), "OUT", Range("N2:N" & lr), cell.Value) ' count "OUT"'s of specific number
        If count > max Then max = count ' get the maximum "OUT" within numbers
        If cell.Offset(, -1).Value = "OUT" And count > 2 Then 'loop through each number with "OUT">=3, then write "number" and "row number" into dictionary
            If Not dic.exists(cell.Value) Then
                k = k + 1
                r = count & "," & cell.Row - 1
                dic.Add cell.Value, r
            Else
                r = r & "," & cell.Row - 1
                dic(cell.Value) = r
            End If
        End If
    Next
    k = 0
    ReDim arr(1 To dic.count, 1 To max * 5 + 1) ' create variable array
Worksheets("Sheet2").Activate
    Range("A3:B3").Value = Array("No.", "Number")
    For Each key In dic.keys
        k = k + 1
        s = Split(dic(key), ",")
        For j = 1 To max * 5 + 1
            arr(k, 1) = k
            arr(k, 2) = key
            For i = 1 To UBound(s)
                Range(Cells(3, i * 5 - 1), Cells(3, i * 5 + 1)).Value = Array("Date", "Data 2", "Data 1")
                arr(k, i * 5 - 1) = rng(s(i), 4) & "/" & rng(s(i), 3) & "/" & rng(s(i), 1)
                arr(k, i * 5) = rng(s(i), 12)
                arr(k, i * 5 + 1) = rng(s(i), 9)
            Next
        Next
    Next
Range("A4").Resize(k, max * 5 + 1).Value = arr
End Sub

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Year		Month	Date					Data 1			Data 2	Action	Number
2	1999		Jan	6					A			J	IN	123456
3	1999		Jan	7					B			K	OUT	7890
4	1999		Feb	8					C			L	OUT	7890
5	1999		Feb	15					D			M	IN	12345
6	1999		Mar	12					E			N	OUT	123456
7	2000		Jan	1					F			O	IN	7890
8	2000		Apr	2					G			P	OUT	7890
9	2000		May	17					H			Q	OUT	12345
10	2000		May	22					I			R	OUT	12345
11	2000		May	22					I			R	OUT	12345
12	2000		May	22					I			R	OUT	12345
Sheet1

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1
2
3	No.	Number		Date	Data 2	Data 1			Date	Data 2	Data 1			Date	Data 2	Data 1			Date	Data 2	Data 1
4	1	7890		07/01/1999	K	B			08/02/1999	L	C			02/04/2000	P	G
5	2	12345		17/05/2000	Q	H			22/05/2000	R	I			22/05/2000	R	I			22/05/2000	R	I
Sheet2

View attachment 64828

Hi! Thanks for the response. I ran into a compile error with the variable key not defined.

For Each key In dic.keys

I think the problem is that the word key gets auto capitalized... I tried to change it to uncapitalized it but it auto switched back to caps like that...

For Each Key In dic.keys

 

[bebo021999]

Hi, sorry for that, may be by chance, " key" declaration was deleted
try to add

Dim key