VBA to retrun list of results based on cell value

[Stu]

Hello, I'm hoping a nice VBA savvy person can help me with a problem.

I have a sheet which will contain data as in the example file I've attached. There will usually be hundreds of rows of data but for the example sheet there's only 4.

What I want to achieve is to have a list generated of all the advisors (column D) that have got a 'No' answer in columns M,N,O,P. It can't count the same row twice, so, for example, if an advisor has a 'No' in columns M and N, I'd only want their name to appear once in the list for that row. If they appear again in other rows that's fine. ,

I've tried various vlookups etc but wasn't able to achieve what I wanted, so I'm assuming it will require VBA. I did try just using the IF formula but I was ending up with loads of blank rows in between the results I wanted.

I'd also like the list to be created on another tab in the workbook, so on my report I can just show that particular tab without all the background data being visible.

Could someone please help? I'm very clued up on VBA so wouldn't really know where to start with this.

Thanks

 

[NoS]

Add a Sheet2 to your example file and try something along the lines of this

Sub Testing()
    Dim rng As Range, cel As Range, i As Long
   
With Sheets("Sheet1")
    Set rng = Intersect(.UsedRange.Offset(1), .Columns("D"))
End With

For Each cel In rng
    For i = 9 To 12
        If cel.Offset(, i).Value = "No" Then
            Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = cel.Value
            Exit For
        End If
    Next i
Next cel
End Sub

 

[Stu]

Thanks, apologies for not responding. I've been off work unexpectedly but will try this today and see how it goes!

 

[Fluff]

Another option

Sub CountNo()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("D2", Range("D" & Rows.count).End(xlUp))
         If Application.CountIf(Cl.Offset(, 9).Resize(, 4), "no") >= 1 Then
            .Item(Cl.Value) = .Item(Cl.Value) + 1
         End If
      Next Cl
      Sheets.Add.Name = "Result"
      Range("A1").Resize(.count).Value = Application.Transpose(.keys)
      Range("B1").Resize(.count).Value = Application.Transpose(.items)
   End With
End Sub

 

[p45cal]

This should add a new sheet with your results. Run it when Sheet1 is showing:

Sub blah()
Z = Application.Transpose(Filter(Application.Transpose([IF(((M2:M2000="No")+(N2:N2000="No")+(O2:O2000="No")+(P2:P2000="No"))>0,D2:D2000)]), False, False, 0))
Sheets.Add.Range("A1").Resize(UBound(Z)) = Z
End Sub

 

[p45cal]

Thanks, apologies for not responding. I've been off work unexpectedly but will try this today and see how it goes!

…and?