How to change the Column format from Vertical to horizontal on the basis of data

[susheeltyagi]

I am looking for small help. I have data in four column with serial number, Alert, Count and Group bases I want to change the data format from vertically to horizontal as below screen shot using vba. I have written some code for read the data from input worksheet and put in Scripting.Dictionary. But I do not know further how to display in horizontal format of column.

Input Data :

Output Data:

Incomplete Source code :

Sub ConsecutiveHorizontal()
Dim wsData As Worksheet, wsOut As Worksheet
    Dim dictSerNo As Object, dictAlert As Object, distAlertGroup
    
    Dim arData, arOut, k, rngOut As Range
    Dim lastrow As Long, i As Long
    Dim serNo As String, alert As String, alertGroup As String
    Dim r As Long, c As Long, t0 As Single: t0 = Timer
    
    Set dictSerNo = CreateObject("Scripting.Dictionary")
    Set dictAlert = CreateObject("Scripting.Dictionary")
    Set distAlertGroup = CreateObject("Scripting.Dictionary")
    
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("AlertFullCode").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Sheets.Add.Name = "OutputData"
    Set wsOut = Sheets("OutputData")
    Set wsData = Sheets("InputData")
    
    r = 1: c = 1
    With wsData
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row  'Device Serial Number
        arData = .Range("A1:D" & lastrow).Value2
       
        ' get unique serno and alert
        For i = 2 To lastrow
            serNo = arData(i, 1)
            alert = arData(i, 2)
            alertGroup = arData(i, 4)
            
            If dictSerNo.Exists(serNo) Then
            ElseIf Len(serNo) > 0 Then
                r = r + 1
                dictSerNo.Add serNo, r
            End If
           
            If dictAlert.Exists(alert) Then
            ElseIf Len(alert) > 0 Then
                c = c + 1
                dictAlert.Add alert, c
                 distAlertGroup.Add alert, alertGroup
            End If             
        Next
    End With
     
     ' add headers
    arOut(1, 1) = "Serial No"
    ' sernos and alerts
    For Each k In dictSerNo
        arOut(dictSerNo(k), 1) = k
    Next
    For Each k In dictAlert
        arOut(1, dictAlert(k)) = k
    Next
    
    '  I do not know how to do further..
End Sub

 

[alansidman]

Why write a lot of code when this can be accomplished in Power Pivot with a Pivot Table? If you would like to see it, then repost your data using XL2BB as we cannot manipulate data in a picture and why should we recreate your existing file.