I want the Order id and driver name separate column

enter image description here

Sub Split_Orders()
    Dim InputCoulmn1 As Range
    Dim InputCoulmn2 As Range
    Dim OutputCoulmn As Range
    Dim FetchRow As Integer
    Dim FetchCol As Integer
    Dim FetchArray() As Variant
    Dim str() As String
    No_Of_Rows = Application.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    Set InputCoulmn1 = Range("$A$2:$B$" & No_Of_Rows)
    FetchRow = 44
    Set OutputCoulmn = Range("$C$2")
    Set InputCoulmn1 = InputCoulmn1.Columns(1)
    Set InputCoulmn2 = InputCoulmn1.Columns(2)
    
    FetchCol = RoundUp(InputCoulmn1.Cells.Count / FetchRow)
    ReDim FetchArray(1 To FetchRow, 1 To FetchCol   1)
    
    For i = 0 To InputCoulmn1.Cells.Count - 1
            xValue = InputCoulmn1.Cells(i   1) & " - " & InputCoulmn2.Cells(i   1)
            iRow = i Mod FetchRow
            iCol = VBA.Int(i / FetchRow)
            FetchArray(iRow   1, iCol   1) = xValue
    Next
        OutputCoulmn(1, 1).Resize(UBound(FetchArray, 1), UBound(FetchArray, 2)).value = FetchArray
End Sub

CodePudding user response：

Don't join them, just copy them.

Sub Split_Orders()
    
    Const LINES = 44
    Dim rngSrc As Range, rngDest As Range
    Dim lastrow As Long, i As Long

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        Set rngSrc = .Range("A2")
        Set rngDest = .Range("C2")
        For i = 2 To lastrow Step LINES
            rngDest.Resize(LINES, 2).Value = rngSrc.Resize(LINES, 2).Value
            Set rngSrc = rngSrc.Offset(LINES)
            Set rngDest = rngDest.Offset(, 3)
        Next
        
    End With
    
End Sub

CodePudding user response：

Distribute Concatenated Values to Columns

Option Explicit

Sub Split_Orders_Delimited()
    
    Const sfRow As Long = 2
    Const sfCol As String = "A"
    
    Const dfCellAddress = "C2"
    Const drCount As Long = 44
    Const dDelimiter As String = " - "
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sfCol).End(xlUp).Row
    If slRow < sfRow Then Exit Sub ' no data
    
    Dim srCount As Long: srCount = slRow - sfRow   1
    Dim srg As Range: Set srg = ws.Cells(sfRow, sfCol).Resize(srCount, 2)
    Dim sData As Variant: sData = srg.Value
    
    Dim dcCount As Long: dcCount = Int(srCount / drCount)
    If srCount Mod drCount > 0 Then
        dcCount = dcCount   1
    End If
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    Dim cdrCount As Long
    Dim sr As Long
    Dim dr As Long
    Dim dc As Long
    
    For dc = 1 To dcCount
        If dc = dcCount Then
            cdrCount = srCount
        Else
            cdrCount = drCount
            srCount = srCount - drCount
        End If
        For dr = 1 To cdrCount
            sr = sr   1
            dData(dr, dc) = sData(sr, 1) & dDelimiter & sData(sr, 2)
        Next dr
    Next dc
    
    Dim dfCell As Range: Set dfCell = ws.Range(dfCellAddress)
    
    ' Clear below and to the right.
    Dim dclrrg As Range: Set dclrrg = dfCell.Resize( _
        ws.Rows.Count - dfCell.Row   1, ws.Columns.Count - dfCell.Column   1)
    dclrrg.Clear
    
    ' Write result.
    Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
    drg.Value = dData

End Sub

EDIT:

Distribute Values to Columns

• '*** indicates the few places where there were changes needed, compared to the previous version.

Sub Split_Orders_To_Columns()
    
    Const sfRow As Long = 2
    Const sfCol As String = "A"
    
    Const dfCellAddress = "C2"
    Const drCount As Long = 44
    'Const dDelimiter As String = " - " '***
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sfCol).End(xlUp).Row
    If slRow < sfRow Then Exit Sub ' no data
    
    Dim srCount As Long: srCount = slRow - sfRow   1
    Dim srg As Range: Set srg = ws.Cells(sfRow, sfCol).Resize(srCount, 2)
    Dim sData As Variant: sData = srg.Value
    
    Dim dcCount As Long: dcCount = Int(srCount / drCount) * 3 - 1 '***
    If srCount Mod drCount > 0 Then
        dcCount = dcCount   3 '***
    End If
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    Dim cdrCount As Long
    Dim sr As Long
    Dim dr As Long
    Dim dc As Long
    
    For dc = 1 To dcCount Step 3 '***
        If dc = dcCount - 1 Then '***
            cdrCount = srCount
        Else
            cdrCount = drCount
            srCount = srCount - drCount
        End If
        For dr = 1 To cdrCount
            sr = sr   1
            dData(dr, dc) = sData(sr, 1) '***
            dData(dr, dc   1) = sData(sr, 2) '***
        Next dr
    Next dc
    
    Dim dfCell As Range: Set dfCell = ws.Range(dfCellAddress)
    
    ' Clear below and to the right.
    Dim dclrrg As Range: Set dclrrg = dfCell.Resize( _
        ws.Rows.Count - dfCell.Row   1, ws.Columns.Count - dfCell.Column   1)
    dclrrg.Clear
    
    ' Write result.
    Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
    drg.Value = dData

End Sub