Rearranging the contents of the worksheet based on the cell Value

[chunkyp]

I am working on an excel worksheet which contains a list of books along with their genre, stocks and sold. What I have been trying to get is to arrange the books based on their name using VBA in a new sheet. And for each collection of books I would like to have a row that counts the total for the stock and sold columns.Could anyone help me in the right direction in solving it?

Initial Worksheet:
testing.JPG

Final Worksheet:
result.JPG

[Richard Buttrey]

Hi,

Have you considered a Pivot Table - see attached

[CK76]

I'd definitely go with PivotTable. So much easier to maintain and set up.

Just as sample here's code to rearrange data (no formatting).

Sub Rearrange()
Dim tempArr
Dim i As Integer, j As Integer, x As Integer: j = 0: x = 2
oData = Sheet1.Range("B2:E" & Sheet1.Cells(Rows.Count, "B").End(xlUp).Row).Value
Sheet2.UsedRange.Offset(1).Clear
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(oData, 1)
        If Not .Exists(oData(i, 2)) Then
            .Add Key:=oData(i, 2), Item:=1
        Else
            .Item(oData(i, 2)) = .Item(oData(i, 2)) + 1
        End If
    Next
    For Each Key In .Keys
        ReDim tempArr(.Item(Key), 4)
        For i = 1 To UBound(oData, 1)
            If oData(i, 2) = Key Then
                tempArr(j, 0) = oData(i, 1)
                tempArr(j, 1) = oData(i, 2)
                tempArr(j, 2) = oData(i, 3)
                tempArr(j, 3) = oData(i, 4)
                j = j + 1
            End If
        Next i
        Sheet2.Cells(x, 2).Resize(.Item(Key), 4) = tempArr
        x = x + .Item(Key)
        Sheet2.Cells(x, 2).Value = "Total"
        Sheet2.Cells(x, 4).Value = Application.Sum(Application.Index(tempArr, 0, 3))
        Sheet2.Cells(x, 5).Value = Application.Sum(Application.Index(tempArr, 0, 4))
        x = x + 2
        j = 0
    Next

End With

End Sub