0

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.

Improve this question
10
  • How you want the data to appear as in Sheet2 ? Commented Oct 8, 2013 at 2:18
  • @Santosh consecutively with the same header as the original data. The purpose is to track and consolidate all consecutive and multiple occurences of defect code. Commented Oct 8, 2013 at 2:22
  • I don't understand your first example... How is Cire Line1 and Circ Line1 together for the consecutive occurrence? or is Cire a typo? Commented Oct 8, 2013 at 6:09
  • @sid yes, its a typo. it should be Circ. thanks. Commented Oct 8, 2013 at 6:11
  • Your objective is to just identify the defect right? If yes then a formula would do? Commented Oct 8, 2013 at 6:19

2 Answers 2

Reset to default
1

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

enter image description here

Logic:

  1. Find Last Row of Sheet1
  2. Insert the formula =A2&B2&D2&F2 in Col H
  3. Insert the formula =IF(H2=H3,"YES",IF(H2=H1,"YES","")) in Col I

  4. Insert the formula =IF(AND(I2="",COUNTIF(H:H,H2)>2),"YES" & H2,"") in Col J

    • The objective to achieve this

    enter image description here

  5. Next Create 2 Sheets for output. Let's output the consecutive records to Consecutive Sheet and multiple records to Multiple sheets

  6. Filter the Col I for Yes and move them to Consecutive sheet
  7. Filter the Col J for Non Blanks and move them to Multiple sheet
  8. Sort the data in Multiple sheet based on Col J
  9. Delete Columns H:J from all sheets

Code:

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:

enter image description here

Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

Works great! :) i just changed the formula in Col I to this =IF(COUNTIF(H:H,H2)<3,IF(H2=H3,"YES",IF(H2=H1,"YES","")),"") This is to get the defect code that is both multiple and consecutive to Multi sheet. Thanks Sid.
1

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.

enter image description here

Improve this answer

1 Comment

thanks Santosh, i'll try to code a vba with this. it will surely get me moving a bit :D

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.