Reputation: 19737
I have this data and I am tracking the consecutive and multiple occurrence of defect code.
Consecutive defect code are those that appear under the same area and line consecutively.
Multiple are those defect code that appear 3 times or more (even if not conscutive)
under the same area and line.
Area Line Lot # Date Code Description Assy Line1 LOT000000001 10/3/2013 13:31 5c Vibration fail Assy Line12 LOT000000002 10/3/2013 13:25 5g Key Malfunction Labl Line2 LOT000000003 10/3/2013 13:08 5a No charge Dice Line1 LOT000000004 10/3/2013 13:03 5b System Fail Dice Line2 LOT000000005 10/3/2013 13:09 3j Sofwware fail Dice Line3 LOT000000006 10/3/2013 13:29 5d No display Circ Line1 LOT000000007 10/3/2013 13:25 3n Short Circ Line1 LOT000000008 10/3/2013 13:38 3n Short Circ Line10 LOT000000009 10/3/2013 13:26 3n Short Circ Line12 LOT000000010 10/3/2013 13:30 3n Short Circ Line2 LOT000000011 10/3/2013 13:02 3n Short Circ Line3 LOT000000012 10/3/2013 13:15 3n Short Circ Line7 LOT000000013 10/3/2013 13:24 3n Short Circ LineA LOT000000014 10/3/2013 13:10 3o Open Circ LineA LOT000000015 10/3/2013 13:14 3n Short Circ LineA LOT000000016 10/3/2013 13:46 3c High Res Circ LineA LOT000000017 10/3/2013 13:47 3n Short Circ LineA LOT000000018 10/3/2013 13:50 3o Open Circ LineA LOT000000019 10/3/2013 13:51 3n Short Circ LineA LOT000000020 10/3/2013 13:55 3b Low Res OSTS Line1 LOT000000021 10/3/2013 13:48 3b Low Res OSTS Line1 LOT000000022 10/3/2013 13:50 3f No Trace OSTS Line11 LOT000000023 10/3/2013 13:06 3a No Signal OSTS Line2 LOT000000024 10/3/2013 13:24 3a No Signal
In this case, my expected result would be:
Circ Line1 LOT000000007 10/3/2013 13:25 3n Short Circ Line1 LOT000000008 10/3/2013 13:38 3n Short
for the consecutive occurrence.
and this for the multiple occurrence.
Circ LineA LOT000000015 10/3/2013 13:14 3n Short Circ LineA LOT000000017 10/3/2013 13:47 3n Short Circ LineA LOT000000019 10/3/2013 13:51 3n Short
So the original data is on Sheet1 and I want the result transferred in Sheet2 with the same header.
What I did is to pass the original data into an array and then iterate through it.
I am not getting what I want though. The code is long so I did not bother to post.
And I think is it easier to make a new code than to debug mine.
Any help will be much appreciated. Thanks in advance.
If you still have questions, just fire it away.
Upvotes: 0
Views: 1336
Reputation: 149335
I am also in favor of using formulas for this and the screenshot that I gave in the comments in your post was derived using formulas. However since you wanted a VBA code, Here it is.
Let's say, your sheet looks like this
Logic:
=A2&B2&D2&F2
in Col H=IF(H2=H3,"YES",IF(H2=H1,"YES",""))
in Col IInsert the formula =IF(AND(I2="",COUNTIF(H:H,H2)>2),"YES" & H2,"")
in Col J
Next Create 2 Sheets for output. Let's output the consecutive records to Consecutive
Sheet and multiple records to Multiple
sheets
Col I
for Yes
and move them to Consecutive
sheetCol J
for Non Blanks
and move them to Multiple
sheetMultiple
sheet based on Col JH:J
from all sheetsCode:
Option Explicit
Sub Sample()
Dim ws As Worksheet, wsConsc As Worksheet, wsMulti As Worksheet
Dim lRow As Long
'~~> Change this to the releavnt sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
'~~> To create Consecutive and Multi sheets, delete existing ones if appl
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Consecutive").Delete
ThisWorkbook.Sheets("Multi").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'~~> Create new sheets for output
Set wsConsc = ThisWorkbook.Sheets.Add: wsConsc.Name = "Consecutive"
Set wsMulti = ThisWorkbook.Sheets.Add: wsMulti.Name = "Multi"
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Columns("H:J").ClearContents
.Range("H2:H" & lRow).Formula = "=A2&B2&D2&F2"
.Range("I2:I" & lRow).Formula = "=IF(H2=H3,""YES"",IF(H2=H1,""YES"",""""))"
.Range("J2:J" & lRow).Formula = "=IF(AND(I2="""",COUNTIF(H:H,H2)>2),""YES"" & H2,"""")"
.Range("H2:J" & lRow).Value = .Range("H2:J" & lRow).Value
.AutoFilterMode = False
With .Range("I1:I" & lRow)
.AutoFilter Field:=1, Criteria1:="=YES"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
wsConsc.Rows(1)
End With
.AutoFilterMode = False
With .Range("J1:J" & lRow)
.AutoFilter Field:=1, Criteria1:="<>"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
wsMulti.Rows(1)
wsMulti.Columns("A:J").Sort Key1:=wsMulti.Range("J2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
.AutoFilterMode = False
.Columns("H:J").ClearContents
wsConsc.Columns("H:J").ClearContents
wsMulti.Columns("H:J").ClearContents
End With
End Sub
Output:
Upvotes: 1
Reputation: 12353
formula in I2
= =A2&B2&G2
formula in J2
= =COUNTIF($I$2:$I$25,I2)
formula in K2
= =I2=I3
formula in L2
= =IF(OR(K2,J2>=3,K1),"Copy","Do not copy")
Filter the data in column L
and copy to desired sheet.
Upvotes: 1