Macro for making selections out of content in cell A1 and content in cell B1 and placing the selections in inserted rows

[HarrySiers]

Dear forumers,

I am looking for a macro that does the following:

Cell B1 contains the following ten words:
one two three four five six seven eight nine ten

Cell C1 contains the following ten words:
eins zwei drei vier fünf sechs sieben acht neun zehn

Desired:

A macro that leaves the content of B1 and C1 unchanged, and that inserts 34 rows below row 1 that contain the following content from B1 and C1:

In the inserted rows 2-35, cells B2-B35:

one two three four
two three four five
three four five six
four five six seven
five six seven eight
six seven eight nine
seven eight nine ten
one two three
two three four
three four five
four five six
five six seven
six seven eight
seven eight nine
eight nine ten
one two
two three
three four
four five
five six
six seven
seven eight
eight nine
nine ten
one
two
three
four
five
six
seven
eight
nine
ten


In the inserted rows 2-35, cells C2-C35:

eins zwei drei vier
zwei drei vier fünf
drei vier fünf sechs
vier fünf sechs sieben
fünf sechs sieben acht
sechs sieben acht neun
sieben acht neun zehn
eins zwei drei
zwei drei vier
drei vier fünf
vier fünf sechs
fünf sechs sieben
sechs sieben acht
sieben acht neun
acht neun zehn
eins zwei
zwei drei
drei vier
vier fünf
fünf sechs
sechs sieben
sieben acht
acht neun
neun zehn
eins
zwei
drei
vier
fünf
sechs
sieben
acht
neun
zehn

After this the macro should jump to row 36 and if row 36 contains similar content (ten words in cell B36 and ten words in cell C36) the macro should repeat itself, until the macro hits upon a row that contains no content, after which the macro should stop.

I am very curious if any of you Excell-whizzkids knows the solution.

Thank you in advance!
Harry

 

[sericom]

Give this a go

Sub processData()    Set r = Range("B1")
    Dim sArr1() As String: Dim sArr2() As String
    Do Until r.Value = ""
        sArr1 = Split(r.Value, " ")
        sArr2 = Split(r.Offset(0, 1).Value, " ")
        If UBound(sArr1) = 9 And UBound(sArr2) = 9 Then
            Rows(r.Row + 1 & ":" & r.Row + 34).EntireRow.Insert
            splitData sArr1, r
            splitData sArr2, r.Offset(0, 1)
            Set r = r.Offset(35, 0)
        Else
            Set r = r.Offset(1, 0)
        End If
    Loop
End Sub


Private Sub splitData(ByRef sArr() As String, ByVal rng As Range)
    w = 1: x = 3
    For i = 7 To 10
        For j = 1 To i
            nStr = ""
            For k = 0 To x
                nStr = nStr & sArr(k + j - 1) & " "
            Next k
            rng.Offset(w, 0) = nStr
            w = w + 1
        Next j
        x = x - 1
    Next
End Sub

 

[HarrySiers]

Thank you very much for your fast reply, Sericom! I ran the macro on a sheet with ten words in B1 and ten other words in C1. When I ran the macro I was asked to give a name to the macro: I typed TEST and pressed F5: After that a popup screen appeared with the following information: Compile error: Expected: end of statement

I am not experienced enough to know what to change to the macro...

Your assistance will be highly appreciated.

Thanks in advance,
Harry

 

[sericom]

Ah, the code didn't display right, the first line should be split into 2 lines like

[COLOR=#333333]Sub processData() 
Set r = Range("B1")[/COLOR]

 

[HarrySiers]

Ah, the code didn't display right, the first line should be split into 2 lines like

[COLOR=#333333]Sub processData() 
Set r = Range("B1")[/COLOR]

Thanks a lot! I will check it out immediately, and let you know!

Question: will the same macro also work if the contents in cells B1 and C1 have a different length, say 9 words each or 8 in B1 and 9 in C1? Or would I need to adjust the macro? Would it be difficult or maybe impossible?

Get back to you soon,
Thanks again,
Harry

 

[HarrySiers]

Hello Sericom,

I ran the macro (first on Sheet1 (Sheet1) and then on ThisWorkbook as well, but in both cases nothing happened. No error message popupscreen this time, but also no action on the Excel sheet. Still only a cell B1 with the ten words in it and C1 with the ten words in it. All other rows were empty. I also ran the macro with a B1 and B2 both containing ten words plus a C1 and C2 both containing ten words, to see if it would work then, but no, same result: just the cells with the content that they already had, and no other (visible) changes to the sheet.

Harry

 

[HarrySiers]

Should I perhaps do something with start a new Module or something like that? And does the macro have to be given a name?

 

[sericom]

Thanks a lot! I will check it out immediately, and let you know!

Question: will the same macro also work if the contents in cells B1 and C1 have a different length, say 9 words each or 8 in B1 and 9 in C1? Or would I need to adjust the macro? Would it be difficult or maybe impossible?

Get back to you soon,
Thanks again,
Harry

This should handle variable word counts

Public Sub processData()
    Set r = Worksheets("Sheet1").Range("B1")
    Dim sArr1() As String: Dim sArr2() As String
    Do Until r.Value = ""
        sArr1 = Split(r.Value, " ")
        sArr2 = Split(r.Offset(0, 1).Value, " ")
        cnt1 = UBound(sArr1) + 1: cnt2 = UBound(sArr2) + 1
        rowsToInsert = Application.WorksheetFunction.Max(cnt1, cnt2) * 4 - 6
        Rows(r.Row + 1 & ":" & r.Row + rowsToInsert).EntireRow.Insert
        splitData sArr1, r, cnt1
        splitData sArr2, r.Offset(0, 1), cnt2
        Set r = r.Offset(rowsToInsert + 1, 0)
    Loop
End Sub


Private Sub splitData(ByRef sArr() As String, ByVal rng As Range, ByVal cnt As Long)
    w = 1: x = 3
    For i = cnt - 3 To cnt
        For j = 1 To i
            nStr = ""
            For k = 0 To x
                nStr = nStr & sArr(k + j - 1) & " "
            Next k
            rng.Offset(w, 0) = nStr
            w = w + 1
        Next j
        x = x - 1
    Next
End Sub

Add a module and copy that code in, then back in excel click Macros and run processData. It will run on Sheet1.

 

[HarrySiers]

This should handle variable word counts

Public Sub processData()
    Set r = Worksheets("Sheet1").Range("B1")
    Dim sArr1() As String: Dim sArr2() As String
    Do Until r.Value = ""
        sArr1 = Split(r.Value, " ")
        sArr2 = Split(r.Offset(0, 1).Value, " ")
        cnt1 = UBound(sArr1) + 1: cnt2 = UBound(sArr2) + 1
        rowsToInsert = Application.WorksheetFunction.Max(cnt1, cnt2) * 4 - 6
        Rows(r.Row + 1 & ":" & r.Row + rowsToInsert).EntireRow.Insert
        splitData sArr1, r, cnt1
        splitData sArr2, r.Offset(0, 1), cnt2
        Set r = r.Offset(rowsToInsert + 1, 0)
    Loop
End Sub


Private Sub splitData(ByRef sArr() As String, ByVal rng As Range, ByVal cnt As Long)
    w = 1: x = 3
    For i = cnt - 3 To cnt
        For j = 1 To i
            nStr = ""
            For k = 0 To x
                nStr = nStr & sArr(k + j - 1) & " "
            Next k
            rng.Offset(w, 0) = nStr
            w = w + 1
        Next j
        x = x - 1
    Next
End Sub

Add a module and copy that code in, then back in excel click Macros and run processData. It will run on Sheet1.

Thanks again, in my Excel ribbon under VIEW the option Macro is 'greyed out', but I will find out how to switch it on. If I understand well I should not activate the macro from within the VB screen, but close the VB screen, go back to the Excel sheet and try to click on Macro when it is available in the ribbon and then 'run processData'. I will try to find out how to do so (am a complete Excel-beginner), and let you know. Thank you for your kind assistance!!

 

[HarrySiers]

Thanks again, in my Excel ribbon under VIEW the option Macro is 'greyed out', but I will find out how to switch it on. If I understand well I should not activate the macro from within the VB screen, but close the VB screen, go back to the Excel sheet and try to click on Macro when it is available in the ribbon and then 'run processData'. I will try to find out how to do so (am a complete Excel-beginner), and let you know. Thank you for your kind assistance!!

Just to check whether I did the right thing initially: I went into the VB editor with Alt/F11 and then copied the code in there and pressed F5. That did not work, so now I will do it from the Excel sheet as soon as the option Macro is no longer greyed out in the ribbon.