Home > Back-end >  sorting with vba
sorting with vba

Time:09-17

please help i want to sort the name column such that each name starts after every blank cell.

enter image description here

I want it look something like this..pls help it's a pretty long column

enter image description here

CodePudding user response:

I's probably better to remove the empty ranges before making the array, but here's one way to distribute the names:

Loading the range ito an array, then go through the numbers and look for empty ranges. This assumes that we are working with column "A" and "B" (1 and 2), starting at the top.

Sub test()
Dim arr As Variant
Dim lastRow As Long, i As Long, j As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
arr = Application.Transpose(Range("B2:B" & lastRow))
Range("B2:B" & lastRow).Clear
j = 1
For i = 2 To lastRow
    Cells(i, 2) = arr(j)
    j = j   1
    If j >= UBound(arr) Then Exit For
    While arr(j) = "" And j < UBound(arr)
        j = j   1
    Wend
    While Not Cells(i, 1).Value = ""
        i = i   1
    Wend
Next i
End Sub

Any leftover names will be removed

CodePudding user response:

Option Explicit

Sub SetNamePosition()
    Dim arr As Variant
    Dim i As Long: i = 1    ' for Loop
    Dim j As Long: j = 1    ' for Array
    Dim lastRow As Long: lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim rngColB As Range: Set rngColB = Range("B2:B" & lastRow)
    Dim rngNames As Range: Set rngNames = Range("C1")   ' Temporary range
    
    ' Get column B names only
    rngColB.SpecialCells(xlCellTypeConstants, 2).Copy
    rngNames.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False

    Set rngNames = Range(rngNames, rngNames.End(xlDown))
    
    ' Load rngNames to array
    arr = Application.Transpose(rngNames)
    
    ' Clear rng of column B and rngNames
    rngColB.Clear
    rngNames.Clear
    
    ' Insert names
    For i = 2 To lastRow
        ' set name
        Cells(i, 1).Offset(0, 1).Value = arr(j)
        
        ' find next cell
        i = Cells(i, 1).End(xlDown).Row   1
        
        j = j   1
    Next i
End Sub
  • Related