Excel VBA, capture first "start" value and last "end" value per group - excel

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