Possible to use VBA to summarise a data table in order of data entry?

[Peter1986]

Hi,

Please can I get advice on whether it is possible to use VBA to create a summary table from a 2 column dataset as follows:

• The input data is a simple list of integer 'values' between 1 and 15.
• The output data should count the number of identical values in a row, give the start and end point of those values, then once the value changes, start counting again. Please see the image below.
• 
  
  
• So in the example above, the first three values are '3', so the first entry in the output states that the value of 3 occurs between the first and third entry, the fourth and fifth are value '4', the 6th and 7th value 3 etc,

I am a 3rd year engineering student and have a large dataset (up to 100,000 rows) to sort, and hence any advice on whether this is likely to be possible would be greatly appreciated.

Many Thanks in advance

Peter

 

[Akuini]

Hi, Peter1986
Welcome to the Board
Try this:

Sub a1121447a()
'https://www.mrexcel.com/board/threads/possible-to-use-vba-to-summarise-a-data-table-in-order-of-data-entry.1121447/

Dim i As Long, j As Long, k As Long
Dim va

va = Range("A1:B" & Cells(Rows.count, "A").End(xlUp).Row)
ReDim vb(1 To UBound(va, 1), 1 To 4)

For i = 3 To UBound(va, 1)
    j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 2) = va(i - 1, 2)
    i = i - 1
    k = k + 1
    
    vb(k, 1) = va(j, 1)
    vb(k, 2) = va(i, 1)
    vb(k, 3) = va(i, 2)
    vb(k, 4) = i - j + 1
    
Next

Range("E3").Resize(k, 4) = vb
End Sub

 

[FatBoyClam]

This will work with your example.

Dim sht As Worksheet, rngSource As Range, rngDest As Range
Dim arrNumbers(3) As Integer

Set sht = Worksheets("Numbers")

Set rngSource = sht.Range("A3")

Set rngDest = sht.Range("E3:H3")

arrNumbers(0) = rngSource.Value
arrNumbers(1) = rngSource.Value
arrNumbers(2) = rngSource.Offset(0, 1).Value
arrNumbers(3) = 1

Set rngSource = rngSource.Offset(1, 0)

Do Until rngSource.Value = ""

    If rngSource.Offset(0, 1).Value <> arrNumbers(2) Then
        rngDest.Value = arrNumbers
        Set rngDest = rngDest.Offset(1, 0)
    
            
        arrNumbers(0) = rngSource.Value
        arrNumbers(1) = rngSource.Value
        arrNumbers(2) = rngSource.Offset(0, 1).Value
        arrNumbers(3) = 1
        
    Else
    
        arrNumbers(1) = rngSource.Value
        arrNumbers(3) = arrNumbers(3) + 1
    
    
    End If
    


    Set rngSource = rngSource.Offset(1, 0)
Loop

rngDest.Value = arrNumbers

 

[Peter1986]

Solved. Thank you for your help - a quick and efficient code.

 

[Peter1986]

Both Akuni and FatBoyClam solutions work efficiently

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.