EnnaSmile
EnnaSmile

Reputation: 103

How to split multiple long rows into smaller rows in excel using vba?

I have around 30 columns of data in one row that I want to split into multiple rows so that every row has 7 columns, but I want the result to be on another sheet. For example:

1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  17  18  19  20
mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri sat...
sun mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri ...
sat mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri sun mon...

And I want it to look like:

1   2   3   4   5   6   7
mon tue wen thu fri sat sun
8   9   10  11  12  13  14
mon tue wen thu fri sat sun
15  16  17  18  19  20
mon tue wen thu fri sat
                        1
                        sun
2   3   4   5   6   7   8
mon tue wen thu fri sat sun
9   10  11  12  13  14  15
mon tue wen thu fri sat sun
16  17  18  19  20
mon tue wen thu fri
                    1   2
                    sat sun
3   4   5   6   7   8   9
mon tue wen thu fri sat sun
10  11  12  13  14  15  16
mon tue wen thu fri sat sun
17  18  19  20  21  22  23
mon tue wen thu fri sat sun
24
mon

I tried adapting some of the codes I found to my problem, but they are all answers to just one row of data. For example I found code:

Public Sub SplitRows()

Dim rowRange As Variant
Dim colCount As Integer
Dim lastColumn As Long
Dim rowCount As Integer
rowCount = Cells(Rows.Count, "A").End(xlUp).Row
Dim ws As Worksheet
Set ws = Sheets("Sheet1")

Dim i As Integer
i = 1
Do While (i < rowCount)
lastColumn = ws.Cells(i, Columns.Count).End(xlToLeft).Column
colCount = ws.UsedRange.Columns.Count
rowRange = Range(Cells(i, 2), Cells(i, colCount))
If Not lastColumn <= 7 Then
    Dim x As Integer
    For x = 2 To colCount - 1
        If Not IsEmpty(rowRange(1, x - 1)) And (x Mod 7) = 1 Then
            Cells(i, 1).Offset(1).EntireRow.Insert
            rowCount = rowCount + 1     
            ws.Cells(i + 1, 1).Value = ws.Cells(i, 1).Value
            Dim colsLeft As Integer
            For colsLeft = x To colCount - 1

                ws.Cells(i + 1, colsLeft - 7).Value = rowRange(1, colsLeft)
                ws.Cells(i, colsLeft + 1).Value = ""    
            Next
        Exit For            
      End If
    Next
End If
i = i + 1
Loop
End Sub

But it only applies on the first row (numbers).

Upvotes: 2

Views: 153

Answers (1)

user4039065
user4039065

Reputation:

Don't build a maze of nested loops and conitional if statements when simple maths applied with the correct functions and methods will suffice.

Sub calendarYear()
    Dim yr As Long, dy As Long
    Dim r As Long, c As Long

    yr = 2018

    With Worksheets("sheet2")
        For dy = DateSerial(yr, 1, 1) To DateSerial(yr, 12, 31)
            r = r - CBool(Month(dy) <> Month(dy - 1)) - CBool(Weekday(dy, vbMonday) = 1)
            c = Weekday(dy, vbMonday)
            .Cells(r, c) = Format(dy, "d" & Chr(10) & "ddd")
        Next dy
    End With
End Sub

enter image description here

Upvotes: 7

Related Questions