Solved: Need help with VBA syntax

[morty]

I do not have much experience in VBA so I was wondering if someone can help me with the syntax of the following problem.

Here is an example table I have:
hxxp://imgur.com/Zlwbm.png (first post so I can't post links or images)

I want to have a cell display a warning if more than 1 cells in column B are "yes" AND the cells in column A (within the same rows of those cells in B that are "yes") are different dates.

Nothing needs to happen if the dates are the same and nothing needs to happen if the cells in B are "no"

I think I may have an idea how to do this but I'm not familiar with VBA syntax if someone could help me with this.

[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)

For each cell in column B
If cell.value = "yes" Then
array += cell.address
End If
End For

If count(array) > 1 Then
For each item in array
array2 += adjacent cell in column A
End For
End If

If array2 has unique values AND range("H6").value is null Then
Range("H6").Value = "Warning: message here"
Else If array2 does not have unique AND range("H6").value is not null Then
Range("H6").Value = null
Else If array2 is null Then
Range("H6").Value = null
End If

End Sub
[/VBA]

[Bob Phillips]

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nMatches As Long

If Not Intersect(Target, Me.Range("A:B")) Is Nothing Then

nMatches = Application.Evaluate("=COUNT(1/FREQUENCY(IF(B2:B20=""yes"",IF(A2:A20<>"""",A2:A20)),IF(B2:B20=""yes"",IF(A 2:A20<>"""",A2:A20))))")
If nMatches > 1 Then MsgBox "Multiples"
End If

End Sub
[/vba]

[morty]

I can't seem to get this to work.

Nothing happens at all.

[morty]

Is there a way to do this:
[VBA]
For Each cell as Range("B1:B10")
If cell.Value = "yes" Then
'This is where I need to dump the adjacent cell's value into an array and don't know how
End If
Next

'This is where I need to check if the array has more than 1 distinct unique value
[/VBA]

[Bob Phillips]

Maybe it should be

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nMatches As Long

If Not Intersect(Target, Me.Range("A:A, H:H")) Is Nothing Then

nMatches = Application.Evaluate("=COUNT(1/FREQUENCY(IF(B2:B20=""yes"",IF(H2:H20<>"""",H2:H20)),IF(B2:B20=""yes"",IF(H 2:H20<>"""",H2:H20))))")
If nMatches > 1 Then MsgBox "Multiples"
End If

End Sub
[/vba]

[mikerickson]

Perhaps
[VBA]Private Sub Worksheet_Change(ByVal Target As Range)
Dim bRange As Range
Dim fStr As String
Dim countYes As Long

With ActiveSheet
Set bRange = Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With

With bRange
fStr = .Offset(0, -1).Address(, , , True) & ",--(" & .Address(, , , True) & "=""yes"")"
fStr = "Sumproduct(" & fStr & ")"

countYes = Application.CountIf(bRange, "yes")

On Error Resume Next
If Evaluate(fStr) = countYes * .Offset(0, -1).Cells(Application.Match("yes", .Cells, 0), 1) Then

Else
MsgBox "message"
End If
On Error GoTo 0
End With
End Sub[/VBA]

[morty]

I appreciate all the help in this thread, I guess I just didn't understand what your code is doing so I couldn't quite get it to work.

Anyway, this is what I ended up putting together after way to long of a time trying to figure out collections.

[VBA]
Function inColl(value As Variant, coll As Collection)
For Each v In coll
If value = v Then
inColl = True
ElseIf value <> v Then
inColl = False
End If
Next
End Function

Private Sub Worksheet_Change(ByVal target As Range)
Dim coll As New Collection
For Each c In Range("U4:U10")
If c.value = "Yes" And Range(c.Address).Offset(0, -1).value <> "" And inColl(Range(c.Address).Offset(0, -1).value, coll) = False Then
coll.Add Range(c.Address).Offset(0, -1).value
End If
Next

If coll.Count > 1 And Range("L20").value = "" Then
Range("L20").value = "Warning: Multiple dates in today's prepayment"
ElseIf coll.Count <= 1 And Range("L20").value <> "" Then
Range("L20").value = ""
End If
End Sub
[/VBA]

[Bob Phillips]

So are you sorted?

[morty]

I am, you can mark as solved, thank you.

[Bob Phillips]

You do the marking, not me.

[mdmackillop]

Hi Morty
This code in effect only checks the last item in the collection as it overwrites previous tests in each loop.
BTW, you should really use Option Explicit and declare all your variables.
[vba]Function inColl(value As Variant, coll As Collection)
Dim v
For Each v In coll
If value = v Then
inColl = True
ElseIf value <> v Then
inColl = False
End If
Next
End Function
[/vba]