Difficult sort problem

**iwannabakat** · 09-14-2014, 08:52 PM

I have a schedule program that uses one cell, (A1) lets say, and then corresponding to that persons name in A1 there is schedule data in B1:W2.

When I add a new employee or delete one, I need to re sort the list to accommodate the change and keep all scheduling information in sync.

My key column will be A, but data is only in every other cell. A1, A3, A5....A(n)

If I use a regular sort, all of the blank cells A2, A4, A6... will be sorted out and I will have two employee names in the space only one should be. (A1 and A2 instead of just A1 and a blank in A2)

Left column is what it is, right column is what I would get with a regular sort and it needs to be a name then a space, the next name and then a space.....

Alex Alex
Ben
Ben Charles
Dave
Charles Edward
Frank
Dave

Edward

Frank

some help with a sort routine that would work would be awesome.

thanks

**alansidman** · 09-14-2014, 09:08 PM

This code will insert a blank row between each row.

Option Explicit

Sub Insert()
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Dim rw As Variant
Dim rng As Range
Set rng = Range("A1:A" & lr)


For Each rw In rng.Rows 'For each row in your range...
    If rw.Row Mod 2 = 0 Then 'check to see if the row is even
        rw.Insert Shift:=xlDown 'if the row is even, insert a blank row above it
    End If
Next rw 'Keep going until you are out of rows


End Sub

**Kaper** · 09-15-2014, 05:41 AM

Try this macro:

Sub test()
Dim lastr As Long, cell As Range
lastr = Cells(Rows.Count, "A").End(xlUp).Row + 1

Columns("A:A").Insert Shift:=xlToRight
Range("A1").Value = 1
Range("A1:A" & lastr).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
Range("A1:X" & lastr).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo
Columns("A:A").Insert Shift:=xlToRight
Range("A1").Value = 1
Range("A1:A" & lastr / 2).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=2, Trend:=False
Range("A1:Y" & lastr).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo
For Each cell In Range("A2:A" & lastr)
  If cell = "" Then cell = cell.Offset(-1, 0) + 1
Next cell
Range("A1:Y" & lastr).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Columns("A:B").Delete Shift:=xlToLeft
End Sub

Hope it is easy to read that
1) in inserted columns are inserted consequtive numbers,
2) then data is sorted on name from column ex-A (now B).
3) first half (ex. A5 A1 A3 etc.) is then numbered in new column (with step 2)
4) and all data is again sorted on numbers from point 1 (original sequence resored)
5) rows with no data in column A are assigned next number after the one from above
6) everything is sorted on column A
7) no longer needed (inserted) columns A and B are deleted