Reputation: 103
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
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
Upvotes: 7