VBA to merge multiple lines in a csv file

[insynch]

Hi all,

I have a csv file with 500 lines, each containing 3 items such as article 1, summary 1, reference 1.

I am trying to merge/group the line items in batches of 15 and add the references as the end of each batch.

So the structure of each new line will look something like the following:
article 1, summary 1, article 2, summary 2...... reference 1, reference 2, ... reference 15 then move on to the next batch of 15 with same structure

in other words something like this:

article 1
summary 1

article 2
summary 2
....
article 15
summary 15

reference 1
reference 2
.....
reference 15

Here is an image of what i mean

Any help will be much appreciated.

Thank you!

 

[Domenic]

The following macro assumes that the worksheet containing your data is the active sheet. Note that the macro first clears the contents of Column E, if any. Then it writes the results to Column E, starting at E2. You may need to amend the macro, depending on your requirements.

Option Explicit

Sub GroupEvery15Articles()

    Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row).ClearContents

    Dim data As Variant
    data = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
   
    Dim group(1 To 15 * 3) As String
    Dim references(1 To 15) As String
   
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim nextRow As Long
   
    j = 1
    k = 1
    nextRow = 2
    For i = LBound(data, 1) To UBound(data, 1)
   
        group(j) = data(i, 1)
        group(j + 1) = data(i, 2)
       
        references(k) = data(i, 3)
       
        If k = 15 Or i = UBound(data, 1) Then
       
            With Cells(nextRow, "E")
                .Resize(UBound(group)).Value = Application.Transpose(group)
            End With
           
            nextRow = Cells(Rows.Count, "E").End(xlUp).Row + 2
            With Cells(nextRow, "E")
                .Resize(UBound(references)).Value = Application.Transpose(references)
            End With
           
            If i = UBound(data, 1) Then Exit For
           
            Erase group
            Erase references
           
            j = 1
            k = 1
           
            nextRow = Cells(Rows.Count, "E").End(xlUp).Row + 2
           
        Else
       
            j = j + 3
            k = k + 1
           
        End If
       
    Next i
   
    MsgBox "Completed", vbInformation
   
End Sub

Hope this helps!

 

[insynch]

The following macro assumes that the worksheet containing your data is the active sheet. Note that the macro first clears the contents of Column E, if any. Then it writes the results to Column E, starting at E2. You may need to amend the macro, depending on your requirements.

Option Explicit

Sub GroupEvery15Articles()

    Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row).ClearContents

    Dim data As Variant
    data = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
  
    Dim group(1 To 15 * 3) As String
    Dim references(1 To 15) As String
  
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim nextRow As Long
  
    j = 1
    k = 1
    nextRow = 2
    For i = LBound(data, 1) To UBound(data, 1)
  
        group(j) = data(i, 1)
        group(j + 1) = data(i, 2)
      
        references(k) = data(i, 3)
      
        If k = 15 Or i = UBound(data, 1) Then
      
            With Cells(nextRow, "E")
                .Resize(UBound(group)).Value = Application.Transpose(group)
            End With
          
            nextRow = Cells(Rows.Count, "E").End(xlUp).Row + 2
            With Cells(nextRow, "E")
                .Resize(UBound(references)).Value = Application.Transpose(references)
            End With
          
            If i = UBound(data, 1) Then Exit For
          
            Erase group
            Erase references
          
            j = 1
            k = 1
          
            nextRow = Cells(Rows.Count, "E").End(xlUp).Row + 2
          
        Else
      
            j = j + 3
            k = k + 1
          
        End If
      
    Next i
  
    MsgBox "Completed", vbInformation
  
End Sub

Hope this helps!

Thank you so much! I will give it a try and keep you posted

 

[insynch]

Worked like a charm! Thank you so much

 

[Domenic]

That's great to hear, glad I could help.

Cheers!