Excel VBA Macro - Concatenating in a Loop

Question

Trying to make a Macro that will insert a row every 1000th row in a spreadsheet and insert a concatenation of the previous 1000 rows of a column into a single cell on that 1000th row in a different column.

I am using this code to insert a row every 1000th row:

Sub Insert1000()
    Dim rng As Range

    Set rng = Range("A2")
    While rng.Value <> ""
        rng.Offset(1000).EntireRow.Insert

        'code insert csv of 1000 previous rows into a single cell

        Set rng = rng.Offset(1001)
    Wend
End Sub

Apologize if my description was not clear. Here is a clip of what I would like my results to be.

Clip

Any help would be appreciated.

Do you want the Concatenation to be a formula or just the concatenated values? And you want it in Column H? — L42
– L42, Commented Oct 10, 2014 at 22:17

Tim Williams · Accepted Answer · 2014-10-10 23:53:27Z

3

EDIT: added missing .EntireRow on marked line

Sub InsertCSV()
    Const BLOCK_SIZE As Long = 1000
    Dim rng As Range, num

    Set rng = Range("A2").Resize(BLOCK_SIZE)
    num = Application.CountA(rng)

    Do While num > 0
        rng.Cells(BLOCK_SIZE + 1).EntireRow.Insert
        With rng.Cells(BLOCK_SIZE + 1).EntireRow '<<edited
        .Cells(1, "H").Value = Join(Application.Transpose(rng.Value), ",")
        .Cells(1, "I").Value = Join(Application.Transpose(rng.Offset(0, 1).Value), ",")
        End With
        Set rng = rng.Offset(BLOCK_SIZE + 1)
        num = Application.CountA(rng)
    Loop

End Sub

edited Oct 10, 2014 at 23:53

answered Oct 10, 2014 at 23:07

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

NaudingAuff Over a year ago

This solution fit my application completely and is understandable at my current skill level. Thank you.

JonnyAggro · Accepted Answer · 2014-10-11 02:22:45Z

1

I would recommend using the Mod operator:

Dim x

For Each x In ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
    If x.Row Mod 1000 = 0 Then
        x.EntireRow.Insert
    End If
Next x

Read about the Mod operator here: http://msdn.microsoft.com/en-us/library/se0w9esz.aspx

or more completely:

Dim x, y, outputText As String

For Each x In ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
    outputText = outputText & x.Value
    If x.Row Mod 1000 = 0 Then
        x.EntireRow.Insert
        x.Value = outputText
        outputText = ""
    End If
Next x

edited Oct 11, 2014 at 2:22

answered Oct 10, 2014 at 22:16

JonnyAggro

1688 bronze badges

2 Comments

Steve S Over a year ago

ActiveSheet.UsedRange.Count returns the total number of cells in the UsedRange, not just the number of rows. When the number of cells in UsedRange is > 1048576, ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Count) will result in an error. In this case you want to use ActiveSheet.UsedRange.Rows.Count.

NaudingAuff Over a year ago

I will read more about the Mod operator. I am learning and your code coupled with the resource will be of great value. Thank you for the direction in my VBA education.

Jur Pertin · Accepted Answer · 2014-10-11 10:52:53Z

Below code should give required output you are looking for:

Sub pInsert1000()

Dim lngLoop             As Long
Dim lngTotal            As Long
Dim lngCounter          As Long
Dim rngRange            As Range
Dim strConcatACol       As String
Dim strConcatBCol       As String

Set rngRange = Cells.Find("*", Cells(1, 1), xlFormulas, xlWhole, xlByRows, xlPrevious)
If Not rngRange Is Nothing Then
    lngTotal = rngRange.Row
Else
    lngTotal = 0
End If

lngCounter = 0
lngLoop = 1
While lngLoop < lngTotal

    lngCounter = lngCounter + 1
    If lngCounter = 1 Then
        strConcatACol = Cells(lngLoop, 1)
        strConcatBCol = Cells(lngLoop, 2)
    Else
        strConcatACol = strConcatACol & ", " & Cells(lngLoop, 1)
        strConcatBCol = strConcatBCol & ", " & Cells(lngLoop, 2)
    End If
    If lngCounter = 1000 Then
        Rows(lngLoop + 1).EntireRow.Insert
        Cells(lngLoop + 1, 8) = strConcatACol
        Cells(lngLoop + 1, 9) = strConcatBCol
        lngLoop = lngLoop + 1
        lngTotal = lngTotal + 1
        lngCounter = 0
    End If
    lngLoop = lngLoop + 1
Wend

Set rngRange = Nothing

End Sub

Collectives™ on Stack Overflow

Excel VBA Macro - Concatenating in a Loop

3 Answers 3

1 Comment

2 Comments

Comments

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

2 Comments

Comments

Related