Solved: Sorting a column alphabetically, however a blank row between names must be retained.

[bananatang]

Hi,

Assistance is once again needed.

I have a list of pupils names starting in Column C16. There is a blank row between each pupils name. The pupils list will increase as names are added on.

I need, if possible to have vba code that will sort the list out in alphabetical order and to maintain the blank row between the pupils name.

Many Thanks in advance

BT

[GTO]

Greetings,

Just to make sure, you are saying that we should expect to see names at C16, C18, C20, C22, C24, C26 and so on, and, that we should have blank cells at C17, C19, C21, C23, C25, C27 and so on. Is that correct so far?

If yes: for the moment, lets say the list ended at C26. Can we count on C27 thru C(bottom row) being blank. I ask as we'd want to ensure we find the end of the list correctly.

Mark

[bananatang]

Greetings,

Just to make sure, you are saying that we should expect to see names at C16, C18, C20, C22, C24, C26 and so on, and, that we should have blank cells at C17, C19, C21, C23, C25, C27 and so on. Is that correct so far?

If yes: for the moment, lets say the list ended at C26. Can we count on C27 thru C(bottom row) being blank. I ask as we'd want to ensure we find the end of the list correctly.

Mark

HI Mark,

Thanks for the quick reply.

You are correct in terms of position of names and blank rows. After the last name there will be no other data in the column. When a new pupils has to be added it will be place below the last named pupils, after a blank row. i.e If the last pupils name is in C30. The new pupils name will be inserted in C32. C31 will be used for the blank row. No other data will be below C32.

Thanks

BT

[mikerickson]

Perhaps something like this
Sub test()
Dim helperCol As Range

With ThisWorkbook.Sheets("Sheet1")
With .UsedRange
Set helperCol = .Cells(1, .Columns.Count + 1).EntireColumn
End With
With Range("C:C")
Set helperCol = Application.Intersect(helperCol, Range(.Cells(16, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
End With
End With

With helperCol
.FormulaR1C1 = "=IF(RC3="""",R[-1]C3&""!"",RC3)"
.Value = .Value
With Range(.EntireRow.Cells(1, 1), .Cells)
.Sort Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
.EntireColumn.Delete
End With
End Sub

[bananatang]

Hi Mikerickson,

Thanks for your code.

Your code is on the right path, it just need slightly tweaked. the code does sort out the column starting from Column C16, however the second pupils name which would be in C18 has been transferred to C17 and so on.

Not sure which bit of your code needs to be amended.

i have attached the worksheet that i am referring to help.

BT

[mikerickson]

This change should fix that
Sub test()
Dim helperCol As Range

With ThisWorkbook.Sheets("Sheet1")
With .UsedRange
Set helperCol = .Cells(1, .Columns.Count + 1).EntireColumn
End With
With Range("C:C")
Set helperCol = Application.Intersect(helperCol, Range(.Cells(16, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
End With
End With

With helperCol
Set helperCol = .Resize(.Rows.Count + 1, 1)
End With

With helperCol
.FormulaR1C1 = "=IF(RC3="""",R[-1]C3&""!"",RC3)"
.Value = .Value

With Range(.EntireRow.Cells(1, 1), .Cells)
.Sort Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

.EntireColumn.Delete
End With
End Sub

[GTO]

Hi again,

This is a bit sloppy, and I need to hit the sack, but I was thinking maybe a bubblesort.

In a Standard Module:

Option Explicit

Sub SortAndSpace()
Dim rngSelected As Range
Dim arySelected
Dim aryTranposed()
Dim arySortedValsSingleDim
Dim i As Long, ii As Long
Dim aryTmp

Set rngSelected = Selection

If Not rngSelected.Column = 3 _
Or Not rngSelected.Columns.Count = 1 _
Or Not rngSelected(1, 1).Address(False, False) = "C16" Then
MsgBox "No DIce"
Else
arySelected = rngSelected.Value

aryTranposed = Application.WorksheetFunction.Transpose(rngSelected.Value)
arySortedValsSingleDim = BubbleSort(aryTranposed)
ReDim aryTmp(0 To 0)
For i = LBound(arySortedValsSingleDim) To UBound(arySortedValsSingleDim)
If Not arySortedValsSingleDim(i) = Empty Then
ReDim Preserve aryTmp(1 To UBound(aryTmp, 1) + 1)
aryTmp(UBound(aryTmp, 1)) = arySortedValsSingleDim(i)
End If
Next

ReDim arySelected(1 To 2 * UBound(aryTmp), 1 To 1)
ii = 0

For i = LBound(arySelected, 1) To UBound(arySelected, 1)
If Not i Mod 2 = 0 Then
ii = ii + 1
arySelected(i, 1) = aryTmp(ii)
Else
arySelected(i, 1) = Empty 'vbNullString
End If
Next

Range(rngSelected(1, 1), _
rngSelected(1, 1).Offset(UBound(arySelected, 1) - 1)).Value = arySelected

' Range(rngSelected(1, 1), rngSelected(1, 1).Offset(UBound(arySelected, 1) - 1)).Select
End If
End Sub


In another Standard Module (note: Base1):


Option Base 1
Option Explicit

'//*************************************************************************** **
'// Contrived from DRJ's KB entry at:
'// http://www.vbaexpress.com/kb/getarticle.php?kb_id=103
'//
'//*************************************************************************** **
Function BubbleSort(MyArray() As Variant) As Variant()

Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As Variant

First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i

BubbleSort = MyArray
End Function


A great day to all,

Mark

[bananatang]

mikerickson, thank you kindly for your code. it now works as it needs to. i will now go ahead and try and understand your code.

GTO thank you for your code too. I will look at that too.

Thank to both of you and GTO happy zzzzzzzzzzzz...

[mikerickson]

The basic technique is to add a helper column where the formula in row 16 would be

=IF($C16="",$C15&"!",$C16) and sort on that