Search code examples
excelvbadate-range

Excel Range to CSVrangeoutput - split range into groups of 41 entries

Im not sure exactly how to explain this in a google search so im not sure if anyone else has asked this.

I have a vba function that takes a range and turns it into a string of comma separated values. It works like a charm.

Now i want it to only output the first 41 entries, switch down a row and output the next 41 entries in the range.

I cant quite wrap my head around it, it feels like a simple loop but i cant quite get there.

I found the csvrange macro online somewhere :)

Function csvRange(myRange As Range)    
    Dim csvRangeOutput
    Dim entry As Variant    
    For Each entry In myRange    
        If Not IsEmpty(entry.Value) Then
            csvRangeOutput = csvRangeOutput & entry.Value & ","
        End If   
    Next
    csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

Input range would look like this
enter image description here

Desired output would look like this, one string located in column B each group of 41 values separated on a row, offsetting 1 down each time the function hits the next nr 42.

enter image description here

Solution

  • Something like this:

    Option Explicit

Public Sub test()

    Debug.Print csvRange(Selection, 41)

End Sub

Public Function csvRange(ByVal myRange As Range, ByVal Columns As Long) As String
    Dim csvRangeOutput
    Dim iCol As Long

    Dim Entry As Variant
    For Each Entry In myRange
        If Not IsEmpty(Entry.Value) Then
            iCol = iCol + 1
            csvRangeOutput = csvRangeOutput & Entry.Value
    
            If iCol = Columns Then
                csvRangeOutput = csvRangeOutput & vbCrLf
                iCol = 0
            Else
                csvRangeOutput = csvRangeOutput & ","
            End If
        End If
    Next
    
    csvRange = Left$(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

    will turn this data

    enter image description here

    into comma separated values with 41 columns

    1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41
42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82
83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123
124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140

    Alternative

    Public Sub Convert()
    Const ColCount As Long = 41
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim iRow As Long
    For iRow = 1 To LastRow Step ColCount
        ws.Cells(iRow \ ColCount + 1, "B").Value = "'" & Join((WorksheetFunction.Transpose(ws.Range("A" & iRow).Resize(RowSize:=IIf(iRow + ColCount - 1 > LastRow, WorksheetFunction.Max(LastRow Mod ColCount, 2), ColCount)).Value)), ",")
    Next iRow
End Sub