Looking for Pair of Values in Same Column - VBA

Originally Posted by awsexcel123

Thank you Akuini! You've helped me greatly! I appreciate all your time and patience in showing me how to code. You've solved my dilemma.

Just a quick question. If I wanted to use the same code for another worksheet in the workbook, would this be correct in the picture? I added "Dim ws As Worksheet" and "For Each ws in Worksheets" and "Next ws."

Attachment 594729

Thank you!!

Try this one:

Sub b1249846e()
'https://www.excelforum.com/excel-programming-vba-macros/1249846-looking-for-pair-of-values-in-same-column-vba.html
Dim i As Long, j As Long, rr As Long, k As Long
Dim va As Variant, vb As Variant
Dim ws As Worksheet

For Each ws In Worksheets
With ws
j = 0
k = 0
rr = .Range("F:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
va = .Range("F2:G" & rr)
ReDim vb(1 To UBound(va, 1), 1 To 2)
ReDim vc(1 To UBound(va, 1), 1 To 2)

For i = 1 To UBound(va, 1) - 1

    If va(i, 2) = 1 And va(i + 1, 2) = 0 Then
    j = j + 1
    vb(j, 1) = va(i + 1, 1)
    End If

    If va(i, 2) = 0 And va(i + 1, 2) = 1 Then
    k = k + 1
    vc(k, 1) = va(i + 1, 1)
    End If

Next
rr = .Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row + 1
.Range("B" & rr).Resize(UBound(vb, 1), 2) = vb

rr = .Range("C:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row + 1
.Range("C" & rr).Resize(UBound(vc, 1), 2) = vc

End With
Next

End Sub