Looking for Pair of Values in Same Column - VBA

Hiya,

Would you be able to upload a sample workbook please? It will help us work through your use case and provide assistance

Edit your post > click "Go Advanced" > "Manage Attachments" > Upload your file(s) > Submit

Hi! I've uploaded the sample workbook. Thank you for all your help!

Hi, this should work for you, not sure where you want the date to be pasted to.

Sub Test()

    Dim wb As Workbook
    Set wb = ThisWorkbook 'Set to instance of your workbook
    
    Dim ws As Worksheet
    Set ws = wb.Sheets("Sheet2") 'Set to instances of your worksheet
    
    Dim nRow As Long
    
    Dim nRow1 As Long
    
    Dim nRow2 As Long
    
    Dim bFound As Boolean
    
    nRow = 4 'Set to first row of data to scan
    
    nRow1 = nRow
    
    Do
        
        bFound = False
        
        If ws.Cells(nRow1, "H").Value = 0 Then
            
            nRow2 = nRow
        
            Do
                
                If ws.Cells(nRow1, "G").Value = ws.Cells(nRow2, "C").Value Then
                
                    bFound = True
                
                End If
                
                nRow2 = nRow2 + 1
            
            Loop While ws.Cells(nRow2, "C").Value <> ""
        
        End If
        
        If bFound = True Then
        
            'If match is found with 0 value in col H, trigger code to copy date
        
        End If
        
        nRow1 = nRow1 + 1
    
    Loop While ws.Cells(nRow1, "G").Value <> ""

End Sub

Thank you Poizhan! I was looking at the code, but couldn’t see how it scans for the pair of values, 0 and 1.

Sorry if I wasn’t very clear. I would like to scan Column H for a pair of numbers, 1 followed by 0. If the code finds a pair, it will take the date in Column G, on the same row where the 0 is, and copy that to the next available row, Column C (Starting at C4). The code will scan the entire Column H for the pair (1 to 0) and copy the dates to Column C.
If you can help me again, I’ll appreciate it very much. Thanks again Poizhan!

Hi, awsexcel123
Try this:

Sub b1249846b()
'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
Dim va As Variant, vb As Variant

rr = Range("G:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
va = Range("G4:H" & rr)
ReDim vb(1 To UBound(va, 1), 1 To 1)

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

Next

Range("C4").Resize(UBound(vb, 1), 1) = vb

End Sub

Hi Akuini,

Thanks for your help. Is there a way you can keep adding to the last available row in Column C. If I import new values to Column H, and run the code, the values in Column C are all replaced. I'd like to keep adding values to Column C. I've provided a picture below as an example. Thanks!Capture12.PNG

When I import new values to column G:H, I delete all the old values and import the new ones. Theoretically, after running the code, new values from Column G will be copied to the next available row in Column C. Your code from before worked exactly how I want it to, but it doesn't let me import new G:H values and add to Column C, it replaces the values instead.

Thank you for all your help Akuini! I hope you can help me with this.

Ok, try this:

Sub b1249846c()
'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
Dim va As Variant, vb As Variant

rr = Range("G:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
va = Range("G4:H" & rr)
ReDim vb(1 To UBound(va, 1), 1 To 1)

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

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

End Sub

Hi Akuini, that is what I'd like the code to do!

I wanted to ask, if you don't mind. If I wanted to do the opposite, and look for values 0 to 1 in Column H, instead of values of 1 to 0 like before. How would you write the code. The new G:H values would be added to Column D, instead of Column C.

Can this code be written with the code from before, so they can be run the same time. If it is difficult to write together, that'll be ok.

Capture15.PNG

Thank you Akuini! I appreciate any help you can give me.

Using your example above:
In Col B data ends at row 6, but in col C data ends at row 5.
If you import new data (then run the macro) where do you fill the data in col C, from row 6 or 7?

Hi Akuini. If new data is imported and the macro is run, the new data will fill in the next available row in Column C (In the case in the example, this will be Row 7). All new data, when macro is run, will imported to the next available cell in each column.

Thanks Akina! You've been great. I appreciate your patience.

Originally Posted by awsexcel123

Hi Akuini. If new data is imported and the macro is run, the new data will fill in the next available row in Column C (In the case in the example, this will be Row 7). All new data, when macro is run, will imported to the next available cell in each column.

Thanks Akina! You've been great. I appreciate your patience.

But next available cell in col C is row 6 not 7 ???

Originally Posted by Akuini

But next available cell in col C is row 6 not 7 ???

Hi Akuini. Youre right. Last available or empty row in Column C would be Row 6. Thanks!

Can you show the desired result (using both criteria)?
Is it ok to assume that in col G before & after '1' is always 0?

Hi Akuini. Here is a picture of results for both criteria. It wouldn't be ok to assume that in Column G there will always be a '0' before and after a '1.' I showed a case of this in the picture.

Thanks again Akuini!

Capture16.PNG

Here’s the new code. I can see you change the data layout, the imported data now in col F:G, and the result in col B:C.

Sub b1249846d()
'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
Dim va As Variant, vb As Variant

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 Sub

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."

Capture1.JPG

Thank you!!

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