Align Data In Groups Of Columns

[Rick Rothstein]

I responded recently to the following question from someone in a different forum...

I have 3 sets of data that I need to line up. The columns are all sorted in alphabetical order . Please see below:

Business Group A	Sales		Business Group B	Sales		Business Group C	Sales
A	23		B	86		D	67
D	5		C	65		L	8
G	4		D	453		M	4
H	65		I	34		W	2
K	76		L	23		X	7
L	87		M	23		Z	1

I need this:

Business Group A	Sales		Business Group B	Sales		Business Group C	Sales
A	23
			B	86
			C	65
D	5		D	453		D	67
G	4
H	65
			I	34
K	76
L	87		L	23		L	8
			M	23		M	4
						W	2
						X	7
						Z	1

My solution was somewhat compact...

Sub LineUpBusinessGroups()
  Dim R As Long, C As Variant, MinText As String
  R = 2
  Application.ScreenUpdating = False
  Do While Application.CountA(Cells(R, "A"), Cells(R, "D"), Cells(R, "G")) > 0
    MinText = Evaluate(Replace("IF(IF(A#&""zzz""< D#&""zzz"",A#&""zzz""," & _
                       "D#&""zzz"")< G#&""zzz"",IF(A#&""zzz""< D#&""zzz""," & _
                       "A#&""zzz"",D#&""zzz""),G#&""zzz"")", "#", R))
    For Each C In Array("A", "D", "G")
      If Cells(R, C) > MinText Then Cells(R, C).Resize(, 2).Insert xlShiftDown
    Next
    R = R + 1
  Loop
  Application.ScreenUpdating = True
End Sub

But I got to thinking about this question in its more general sense... What if there were more columns within each group? What if the offset between groups was different? What if the "table" of data did not start on Row 1 or in Column A? What if the data were not pre-sorted? What if the column used for aligning the groups was not the first column in the group (perhaps the first column in the group was a date column followed by a name column followed by data columns)? So I decided to create a generalized routine that the user can pass the structure of the data into as arguments. Here is what I came up with (not anywhere as compact as my solution to the specific question asked originally, but to be expected when coding for a user-specified general setup)...

Sub SortAndAlignGroups(GroupStartCell As Range, GroupOffset As Long, ColsPerGroup As Long, _
                       Optional CompareColOffset As Long = 0, Optional HasHeader As Boolean = True, _
                       Optional LastCol As Variant = 0, Optional SpacedRows As Boolean = False)
  Dim R As Long, C As Long, StartCol As Long, GroupsCount As Long
  Dim CompareStartCell As Long, MinText As String
  StartCol = GroupStartCell.Offset(, CompareColOffset).Column
  If LastCol = 0 Then
    LastCol = Cells(GroupStartCell.Row, Columns.Count).End(xlToLeft).Column
  Else
    LastCol = Cells(GroupStartCell.Row, LastCol).Column
  End If
  R = GroupStartCell.Row - HasHeader
  Application.ScreenUpdating = False
  For C = StartCol To LastCol Step GroupOffset
    Cells(R, C).Resize(Rows.Count - R, ColsPerGroup).Sort Cells(R, C + CompareColOffset), Header:=xlNo
  Next
  Do While Application.CountA(Rows(R)) > 0
    MinText = ""
    For C = StartCol To LastCol Step GroupOffset
      If MinText = "" And Cells(R, C) <> "" Then
        MinText = Cells(R, C)
      ElseIf Cells(R, C) < MinText And Cells(R, C) <> "" Then
        MinText = Cells(R, C)
      End If
    Next
    For C = StartCol To LastCol Step GroupOffset
      If Cells(R, C) > MinText Then
        Cells(R, C - CompareColOffset).Resize(1 - SpacedRows, ColsPerGroup).Insert xlShiftDown
      ElseIf SpacedRows Then
        Cells(R - SpacedRows, C - CompareColOffset).Resize(1, ColsPerGroup).Insert xlShiftDown
      End If
    Next
    R = R - SpacedRows + 1
  Loop
  Application.ScreenUpdating = True
End Sub

Here is a description for each of the arguments...

GroupStartCell - This is a range reference to the first cell in the data table.

GroupOffset - This is the column offset between groups (using the first table above, this value would be set as 3 since Column D is three columns to the right of Column A... the offsets between groups is always going to be the same).

ColsPerGroup - This is the number of columns making up a single group. This argument coupled with the first two arguments above allows you to work with multiple groups with zero or more blank columns between the groups.

CompareColOffset- This argument is optional and sets the offset from the group's first column to the column which the data will be aligned on. The default for this argument is 0 meaning the first column in the group will be used for aligning the groups.

HasHeader- This argument is optional and tells the code whether to ignore the first row or not. The default for this argument is True meaning the code will assume there is a header and ignore it.

LastCol- This argument is optional and, if specified, should be set to the last column of the last group (it can be specified as the column number or the quoted column letter designation). Being able to specify a last column allows for additional data to exist to the right of the data being aligned... that data, as well as any data to the left of the cell reference specified in the first argument, will not be touched or moved. The default for this argument when omitted is 0 meaning the code will calculate the last column in the last group on the assumption that there is not data to the right of it.

SpacedRows- This argument is optional and, if set to True, will place a blank row between each row outputted. The default is False meaning no separator rows will be inserted.

Whoops, I almost forgot to mention... this is a subroutine, not a macro, so it needs to be called from within other VB code. For the question that led to this article (see the two tables at the beginning of this article), the call to my subroutine would look like this (no optional arguments are specified)...

SortAndAlignGroups Range("A1"), 3, 2

I am not sure if anyone will actually find a need for this routine, but I found the extended question it answer somewhat intriguing, which is the main reason I created the code. Not wanting to waste the effort it took to write it, I figured I might as well post it here just in case someone at some time in the future might find it useful.


EDIT NOTE: I forgot to mention when I first posted this (apologies to the 7 people who have already viewed this article), you do not have sort your data before calling this routine... it will automatically sort each group individually according to the specified compare column.





https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwTUdEgR4bdt6crKXF4AaABAg. 9xmkXGSciKJ9xonTti2sIx
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwWw16qBFX39JCRRm54AaABAg. 9xnskBhPnmb9xoq3mGxu_b
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9xon1p2ImxO
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgybZfNJd3l4FokX3cV4AaABAg. 9xm_ufqOILb9xooIlv5PLY
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9y38bzbSqaG
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgyWm8nL7syjhiHtpBF4AaABAg. 9xmt8i0IsEr9y3FT9Y9FeM
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9xpn-GDkL3o
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA