2

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).

EnnaSmile
  • 103
  • 10
  • There must be some background you're not sharing... is this a homework assignment or something? Because 30 columns into 7 columns is "nothing". To do it manually would take less time that it did for you to post the question... – ashleedawg Mar 15 '18 at 08:01
  • @ashleedawg I have sheet with 12 months with all days of the month being in a row. It's kinda homework and I have to use vba and can't do it manually. – EnnaSmile Mar 15 '18 at 08:05
  • (Oh, it's you, more homework huh?!) So the fsheet is 12 lines long x 30 wide kind of thing? You could use a couple nested `Do..,While` loops . "Count to 7, newline, repeat" and `exit do` when you reach 30. Then another `Do While` to repeat that for each month. – ashleedawg Mar 15 '18 at 08:11
  • @ashleedawg (yes, me again) It's 25 lines long and 30-31 wide, depending of the month. I think I could manage the those do whiles, but the thing that bothers me is how to put first day of the month on the, for example, 5th column if the last day of previous day was in 4th column. – EnnaSmile Mar 15 '18 at 08:17
  • 2
    Have a running counter that doesn't reset until it gets to 7. Another way to do this quickly would be a VBA RegEx expression. – ashleedawg Mar 15 '18 at 08:19
  • @ashleedawg thank you, I'll try using RegEx, seems like it could help. :) – EnnaSmile Mar 15 '18 at 08:22
  • Just a note: `Dim rowCount As Integer` Excel has more rows than `Integer` can handle. Therefore always use `Long` instead of `Integer` in VBA. There is no benefit in using `Integer` at all. – Pᴇʜ Mar 15 '18 at 08:33
  • @Pᴇʜ thank you for the tip. – EnnaSmile Mar 15 '18 at 08:50
  • @Pᴇʜ ***re: "no benefit to `Integer`"*** - I was about to debate that claim since `Long` uses [double the storage space](https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/data-type-summary), but I guess if it's *literally* 2 bytes difference then you're actually ***saving*** memory ((for only a **√** of the capacity) by using `long` since the *word* "long" is 3 *letters* shorter, and `3b - 2b = 1b savings`... *(I wonder how many times I've typed the word "`Integer`" in 25 years, multiplied by **3** wasted keystrokes each time....)* ... – ashleedawg Mar 15 '18 at 11:01
  • @EnnaSmile - I suppose with assignments like this there's a rule about recording macros? Technically it *is* still VBA, and all you would need is to record a couple cuts/inserts/pastes, and loop them. :-) – ashleedawg Mar 15 '18 at 11:07
  • @ashleedawg When I said "no benefit" I referred to the fact that "*on a 32 bit system, a 16 bit integer gets silently converted to a long without the benefit of the larger range of numbers to work with*". So there is just no memory saving effect (unless you are really on a 16 bit system). For more info and references [have a look here](https://stackoverflow.com/a/26409520/3219613) – Pᴇʜ Mar 15 '18 at 11:24

1 Answers1

7

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

  • This is almost what I need, can you explain the code to me so I can adapt it? Because I already have cells on the sheet with days of the month that I need transferred into this format. – EnnaSmile Mar 15 '18 at 09:16
  • For all intents and purposes, there are five lines of operational code. What requires explaining that a few minutes of google-fu can't explain faster and better? –  Mar 15 '18 at 09:19
  • Nothing, I'll try to figure out how to use this to solve my problem. Thank you for your help. :) – EnnaSmile Mar 15 '18 at 09:39
  • 2
    @EnnaSmile `yr = 2018` is a number of a year that is used in this procedure, you can replace it with `yr = Year(Date)` to get the current year number. [DateSerial](https://msdn.microsoft.com/en-gb/vba/language-reference-vba/articles/dateserial-function) returns **Date** for a specified year, month, and day. So basicly, he is looping through each day in specified year. `r` and `c` are numbers of a cell's row and column respectively. – AntiDrondert Mar 15 '18 at 09:47
  • 2
    @EnnaSmile `c` is calculated by [Weekday](https://support.office.com/en-us/article/WEEKDAY-function-60E44483-2ED1-439F-8BD0-E404C190949A) function that returns the day of the week corresponding to a date. The day is given as an integer, ranging from 1 (Sunday) to 7 (Saturday), by default. `r` is a bit tricker. First of all, [CBool](https://www.techonthenet.com/excel/formulas/cbool.php) converts a value to a boolean, used with conditions like `Month(dy) <> Month(dy - 1)` (Month of the current day is not equal to the month of previous day) will return either `False` or `True`. – AntiDrondert Mar 15 '18 at 09:57
  • 2
    @EnnaSmile When Visual Basic converts [Boolean](https://learn.microsoft.com/en-gb/dotnet/visual-basic/language-reference/data-types/boolean-data-type) values to numeric types, like in Jeeped's line `r = r - CBool(Month(dy) <> Month(dy - 1)) - CBool(Weekday(dy, vbMonday) = 1)`, `False` becomes `0` and `True` becomes `-1`. For example for `01.01.2018` `r` will be equal to `2` because `r` was `0` at the start of the sub, so `r=0-False-False` which is equal to `r=0-(-1)-(-1)` or `r=0+1+1`. Hope that helped. – AntiDrondert Mar 15 '18 at 09:59
  • @Jeeped This answer is amazing and I learned a lot from that as well, thank you. – AntiDrondert Mar 15 '18 at 10:05