Excel VBA, capture first “start” value and last “e

Question

Using Excel VBA, I'm trying to capture the first value in a column "Start" and the last value in a column "End", per group. Data is already sorted. Example:

I want to capture the first value for Start_open and the last value for Start_end per company. So for Company A code should put B2 in Start_Open and put C5 in Start_end.

Capturing the last value works fine using this code:

Sub First_last()

Dim i, j As Integer
Dim LastRow, LastCol As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column


For i = 2 To LastRow
    If Cells(i + 1, "A").Value <> Cells(i, "A").Value Then
        MsgBox i
        Cells(j + 2, "E").Value = Cells(i, "C").Value
        j = j + 1
    End If
Next

End Sub

What I'm struggling with is capturing Start_open per group. I think I need to use above condition and use a counter to capture Start_open per group but I can't find the right code. Please advise, thanks!

Answer 1

You can use variables a and b to find the start and end of each section:

 Dim a as Long, b as Long, i as Long, lr as Long
 lr = cells(rows.count,1).end(xlup).row
 For i = 2 to lr
     If cells(i,1).value = cells(i+1,1).value then
          If a = 0 then
              a = i + 1
          End If
     Else
          If a > 0 AND b = 0 then
              b = i + 1
          End If             
     End If
     If b > 0 AND a > 0 Then
         'perform max(range(cells(a,2),cells(b,2))), etc.
         a = 0 'resets for next grouping
         b = 0 'resets for next grouping
    End If
Next i
a = 0
b = 0

Answer 2

To add another method into the mix.

Sub x()

Dim r As Range, oDic As Object, r1 As Range, r2 As Range, r3 As Range, v(), i As Long

Set oDic = CreateObject("Scripting.Dictionary")
Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
ReDim v(1 To r.Count, 1 To 3)

For Each r3 In r
    If Not oDic.Exists(r3.Text) Then
        Set r1 = r.Find(What:=r3, After:=r(r.Count), LookAt:=xlWhole, _
                        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set r2 = r.Find(r3, r(1), , , , xlPrevious)
        i = i + 1
        v(i, 1) = r3
        v(i, 2) = r1.Offset(, 1).Value
        v(i, 3) = r2.Offset(, 2).Value
        oDic.Add r3.Text, Nothing
    End If
Next r3

Range("D2").Resize(oDic.Count, 3) = v

End Sub

Answer 3

This will do what you want:

Sub First_Last()
    With ActiveSheet
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        Dim numUnique
        numUnique = .Evaluate("SUM(1/COUNTIF(A:A,A2:A" & LastRow & "))")

        Dim outarr As Variant
        ReDim outarr(1 To numUnique, 1 To 2)

        Dim clmc As Variant
        clmc = .Range(.Cells(1, 3), .Cells(LastRow, 3)).Value

        Dim clmb As Variant
        clmb = .Range(.Cells(1, 2), .Cells(LastRow, 2)).Value

        Dim j As Long
        j = 1

        Dim i As Long
        For i = 2 To LastRow
            outarr(j, 1) = clmb(i, 1)
            Dim k As Long
            k = .Evaluate("AGGREGATE(14,6,ROW(A2:A" & LastRow & ")/(A2:A" & LastRow & " = " & .Cells(i, 1).Address & "),1)")
            outarr(j, 2) = clmc(k, 1)
            j = j + 1
            i = k
        Next i

        .Range("D2").Resize(UBound(outarr, 1), UBound(outarr, 2)).Value = outarr
    End With
End Sub