Require macro

[Ron99]

Hello,

PN's in each row are alternate to each other but they are repeated in other rows in different order / sequence

Example - PN's in 1st row are also in row 3,5 & 7.

Output requirement - I need to retain only 1 row which has the maximum alternate parts and delete the remaining rows. In this case it should retain Row7 and delete Row 1,3 & 5. The same should happen to B PN's and so on.

PN	ALT1	ALT 2	ALT3	ALT4	ALT5
A1	A2	A3	A4	A5
B1	B2	B3	B4	B5	B6
A2	A1	A3	A4
B2	B1	B3	B4	B5
A3	A4	A5
B3	B1	B2	B4	B5
A4	A5	A1	A2	A3	A6

<tbody>
</tbody>

 

[Fluff]

If you simply want to delete all rows where col F is empty, try

Sub DelRws()
   Columns(6).SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[Ron99]

Thank you, just another quick one. How about deleting duplicate lines incase there is no blanks. The sequence is not the same but should identify duplicates in another row and delete. Incase if the data was this way. PN is the main source and if any duplicates identified in another row should delete that row A1 appears in row 3, 5 & 7. These rows to be deleted. same should apply for B1 and so on. Thanks for your help!

PN	ALT1	ALT 2	ALT3	ALT4
A1	A2	A3	A4	A5
B1	B2	B3	B4	B5
A2	A1	A3	A4	A5
B2	B1	B3	B4	B5
A3	A4	A5	A1	A2
B3	B1	B2	B4	B5
A4	A5	A1	A2	A3

<tbody>
</tbody>

 

[Fluff]

How about

Sub DelRws()
   
   Dim Cl As Range
   Dim Cnt As Long
   Dim Qty As Long
   Dim Rng As Range
   Dim Fnd As Range
   
   Set Rng = Range("A1").CurrentRegion
   Columns(Rng.Columns.Count).SpecialCells(xlBlanks).EntireRow.Delete
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Qty = WorksheetFunction.CountIf(Rng, Cl.Value)
      If Qty > 1 Then
         For Cnt = 1 To Qty - 1
            Set Fnd = Rng.Find(Cl.Value, Cl, , , , , True, , False)
            Fnd.EntireRow.ClearContents
         Next Cnt
      End If
   Next Cl
   
End Sub

 

[Ron99]

Hello,

I really appreciate your time and help on this one. I did run the code but unfortunately showing error on this line

Columns(Rng.Columns.Count).SpecialCells(xlBlanks).EntireRow.Delete

 

[Fluff]

How about

Sub DelRws()
   
   Dim Cl As Range
   Dim Cnt As Long
   Dim Qty As Long
   Dim Rng As Range
   Dim Fnd As Range
   
   Set Rng = Range("A1").CurrentRegion
   On Error Resume Next
   Columns(Rng.Columns.Count).SpecialCells(xlBlanks).EntireRow.Delete
   On Error GoTo 0
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Qty = WorksheetFunction.CountIf(Rng, Cl.Value)
      If Qty > 1 Then
         For Cnt = 1 To Qty - 1
            Set Fnd = Rng.Find(Cl.Value, Cl, , , , , True, , False)
            Fnd.EntireRow.ClearContents
         Next Cnt
      End If
   Next Cl
   
End Sub

 

[Ron99]

Bulls-eye!!! amazing...This has saved tons of time thank you very much.. before you leave I have one last request..

I want the code to lookup the entire row matching any other row and delete that row.

Example - code can delete Row 3 & Row 7 as it matches with Row 1 even though it is not of the same order but it is same alpha numeric in a different sequence. This time the code should not delete Row 5 as all the alpha numeric does not match all. This should apply for the rest of the table as it I not limited to only these rows and columns.

PN	ALT1	ALT 2	ALT3	ALT4	ALT5
A1	A2	A3	A4	A5	A6
B1	B2	B3	B4	B5	B6
A2	A1	A3	A4	A5	A6
B2	B1	B3	B4	B5	B6
A3	A4	A5	A7	A8	A1
B3	B1	B2	B4	B5	B8
A4	A5	A1	A2	A3	A6

<colgroup><col width="35" style="width: 26pt; mso-width-source: userset; mso-width-alt: 1280;"> <col width="37" style="width: 28pt; mso-width-source: userset; mso-width-alt: 1353;"> <col width="42" style="width: 32pt; mso-width-source: userset; mso-width-alt: 1536;"> <col width="40" style="width: 30pt; mso-width-source: userset; mso-width-alt: 1462;"> <col width="41" style="width: 31pt; mso-width-source: userset; mso-width-alt: 1499;"> <col width="42" style="width: 32pt; mso-width-source: userset; mso-width-alt: 1536;"> <tbody> </tbody>

Thank you once again and advance happy new year!!

Thanks,
Ron..

 

[Fluff]

I'm afraid I don't know how to do that.

 

[Ron99]

Thank you for all the help....

Anyone who can help me out ?