I think I need a Macro! :)

[TripletDad]

I have a report that (among other things) has two columns: Column A = Order Number, Column B = Yes or No

I need to find out what orders (Column A) have both a YES and NO.

For example I would run the macro against the grid below and it would return 24567 and 24570 in a thrid column (because they have a YES and NO and the other orders don't.)

Sheet1

*	A	B
1	ORDER	AVAILABLE
2	24567	Yes
3	24567	Yes
4	24567	No
5	24568	No
6	24568	No
7	24568	No
8	24569	Yes
9	05559	Yes
10	05559	Yes
11	05559	Yes
12	24570	No
13	24570	No
14	24570	Yes
15	24571	Yes
16	24573	Yes

<tbody>
</tbody>

Does this make sense? Maybe I'm making it too hard?

Any help is very much appreciated!

Thank you!

 

[mjbeam]

lr = ActiveSheet.UsedRange.Rows.Count
sr = 2
Do
    tOrder = Cells(sr, 1)
    tYes = False
    tNo = False
    For i = sr To lr
        If Cells(i, 1) = tOrder Then
            If Cells(i, 2) = "Yes" Then tYes = True
            If Cells(i, 2) = "No" Then tNo = True
        End If
        If tYes = True And tNo = True Then
            dr = 0
            Do
                dr = dr + 1
                If Cells(dr, 3) = "" Then Cells(dr, 3) = tOrder
                DoEvents
            Loop Until Cells(dr, 3) = tOrder
            i = lr
        End If
    Next i
    sr = sr + 1
    DoEvents
Loop Until Cells(sr, 1) = ""

 

[Momentman]

Basedon your data, This code would put the values that meet your criteria in column F

Sub Availables()
    Set Rng = Range("B2:B16")
    Set Rng2 = Range("c2:C16")
    lastrow = Range("A65536").End(xlUp).Row
    lastrow2 = 1
    
    For I = 2 To lastrow
        
        ask = Range("B" & I).Value
       Set rng3 = Range("F2:F" & lastrow2)
        
        If Application.WorksheetFunction.CountIf(Range("F2:F" & lastrow2), Cells(I, "B").Value) < 1 _
        And Application.WorksheetFunction.CountIfs(Rng, Cells(I, "b").Value, Rng2, "Yes") > 0 And _
        Application.WorksheetFunction.CountIfs(Rng, Cells(I, "b").Value, Rng2, "No") > 0 Then
                lastrow2 = lastrow2 + 1
                Cells(lastrow2, "F").Value = Cells(I, "b").Value
        Else
                 lastrow2 = lastrow2
        
        End If
                
    Next I
End Sub

 

[TripletDad]

Perfect - thank you!!!

 

[mikerickson]

A non VBA solution would be to put the CSE formula

=SMALL(IF(COUNTIFS($A$2:$A$16, $A$2:$A$16, $B$2:$B$16, IF($B$2:$B$16="Yes","No","Yes"))>0, IF(MATCH($A$2:$A$16,A:A,0)=ROW($A$2:$A$16), $A$2:$A$16)), ROWS($1:1))

in a cell and drag down.

 

[TripletDad]

Hey Guys,

I just got back to this project and found that the Macros don't work... Can you double check? Perhaps I am doing something wrong?

Any help you can offer is greatly appreciated.

Thank you!

-Jeff

 

[mirabeau]

try

Option Explicit
Sub sxjsj()
Dim d1 As Object, d2 As Object, a
Dim s As String, j As Long, z As Long
Dim k2, i2, p, q

Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
d1.compareMode = 1: d2.compareMode = 1

a = Cells(1).CurrentRegion.Resize(, 2)
s = Chr(30)

For j = 2 To UBound(a, 1)
    d1(a(j, 1)) = d1(a(j, 1)) & s & a(j, 2)
    d2(a(j, 1)) = d2(a(j, 1)) & s & j
Next j

k2 = d2.keys: i2 = d2.items
For Each p In d1.items
    If InStr(p, "Yes") > 0 And InStr(p, "No") > 0 Then
        For Each q In Split(i2(z), s)
           If Len(q) > 0 Then Cells(q, 3) = k2(z)
        Next q
    End If
    z = z + 1
Next p
End Sub

 

[TripletDad]

Hi Mirabeau,

This worked great. Thank you so much. Just 2 quick questions:

1) The sample I provided is just a sample file and the actual file the data is in different columns (not "A" and "B"), but "A" for orders and "AK" for available. I also need to change the column where it outputs the data as that is currently "C". Can you tell me where I would make that change in your code?

2) I see the output is repeating the orders that have both YES and NO. Is there an easy way to make it so that it only outputs that order number one time so they are unique? It is easy to remove duplicates after we run the macro, so big deal, but if that is easy change to make that would be one less step for us.

Thanks,
Jeff

 

[mirabeau]

Hi Mirabeau,

This worked great. Thank you so much. Just 2 quick questions:

1) The sample I provided is just a sample file and the actual file the data is in different columns (not "A" and "B"), but "A" for orders and "AK" for available. I also need to change the column where it outputs the data as that is currently "C". Can you tell me where I would make that change in your code?

2) I see the output is repeating the orders that have both YES and NO. Is there an easy way to make it so that it only outputs that order number one time so they are unique? It is easy to remove duplicates after we run the macro, so big deal, but if that is easy change to make that would be one less step for us.

Thanks,
Jeff

Jeff,

Maybe this one

Sub xx()

Dim d1 As Object, d2 As Object
Dim a, b
Dim lr As Long, j As Long

Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
d1.comparemode = 1: d2.comparemode = 1

lr = Range("A" & Rows.Count).End(3).Row
a = Range("A1").Resize(lr)
b = Range("AK1").Resize(lr)

For j = 2 To UBound(a, 1)
    If Not d1.exists(a(j, 1)) Then
        d1.Add a(j, 1), b(j, 1)
    Else
        If Not d1(a(j, 1)) = b(j, 1) Then d2(a(j, 1)) = 1
     End If
Next j

Range("C2").Resize(d2.Count) = Application.Transpose(d2.keys)

End Sub