VBA Script to hide rows

[ifu06416]

Hi there

I'm trying to build a code that will look down column A, containing case references, and hide the row if part of the case has been rejected, col c. Now this is simple enough but the problem is that there can be any number of parts to a case and each part is recorded on a new row, so a case can have any number of rows.

If any one of the rows relating to the col A case reference has been rejected then all the rows with that case reference have to be hidden. This should leave me with only case references where nothing has been rejected.

So in the example below only case ref 2 would remain unhidden, as it is the only one with no rejects associated with it.

	A	B	C
1	Case ref	Customer	Outcome
2
3	case ref 1	J Bloggs	reject
4	case ref 2	R Bloggs	uphold
5	case ref 2	R Bloggs	uphold
6	case ref 3	K Bloggs	reject
7	case ref 4	S Bloggs	reject
8	case ref 4	S Bloggs	uphold
9	case ref 4	S Bloggs	reject

<tbody>
</tbody>

I've not been able to come up with a way around this using functions so i think VBA is he best way.

any help would be appreciated.

John.

 

[ifu06416]

Ahh sorry! I dont have Internet access on the computer in work so it was a bit of a manual typing job.

That code is working perfectly now.

I do have one more question if you don't mind.

If I wanted to delete the row instead of hiding it what would I change in the script?

Regards.

 

[Rick Rothstein]

If I wanted to delete the row instead of hiding it what would I change in the script?

Give this a try...

[table="width: 500"]
[tr]
	[td]Sub HideRejects()
  Dim R As Long, LastRow As Long, CaseRefs As String
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  For R = 1 To LastRow
    If LCase(Cells(R, "C").Value) = "reject" Then
      If InStr(1, CaseRefs & Chr(1), Chr(1) & Cells(R, "A").Value & Chr(1), vbTextCompare) = 0 Then
        CaseRefs = CaseRefs & Chr(1) & Cells(R, "A").Value
      End If
    End If
  Next
  Application.ScreenUpdating = False
  For R = LastRow To 1 Step -1
    If InStr(1, CaseRefs & Chr(1), Chr(1) & Cells(R, "A").Value & Chr(1), vbTextCompare) Then
      Rows(R).Delete
    End If
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[Peter_SSs]

Perhaps my posts aren't even showing in the thread () but I'll post anyway since as far as I can see this can still be done without looping through the range twice - or even once.

Sub Delete_Rejects()
  Application.ScreenUpdating = False
  With Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row)
    .Offset(, 100).Cells(2, 1).Formula = Replace("=COUNTIFS(A2:A#,A2,C2:C#,""Reject"")>0", "#", .Rows.Count)
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Offset(, 100).Resize(2, 1), Unique:=False
    .Offset(1).EntireRow.Delete
    .Offset(, 100).Cells(2, 1).ClearContents
    On Error Resume Next
    .Parent.ShowAllData
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

.. or if shorter is desired & if the column C values are not formulas that require keeping as formulas:

Sub Delete_Rejects_v2()
  With Range("C3", Range("C" & Rows.Count).End(xlUp).Offset(1))
    .Value = Evaluate(Replace(Replace(Replace("if(len(#),if(countifs($a$2:$a$^,%,$c$2:$c$^,""reject""),1,#),1)", "#", .Address), "^", .Rows.Count + 1), "%", .Offset(, -2).Address))
    .SpecialCells(xlConstants, xlNumbers).EntireRow.Delete
  End With
End Sub

 

[ifu06416]

Hi Peter,

I was struggling a bit so decided to focus on one persons approach. The work is done now so i have time to look over some other approaches as ill probably have to do the same thing again, your approach will be first on the list.

John

 

[ifu06416]

Thanks Rick, this worked perfectly.

 

[Peter_SSs]

Hi Peter,

I was struggling a bit so decided to focus on one persons approach. The work is done now so i have time to look over some other approaches as ill probably have to do the same thing again, your approach will be first on the list.

John

Fair enough. At least now I know that you have seen my suggestions. Whether you implement or even try them is of course up to you. It is encouraging for helpers though to receive some acknowledgement.