Trying to expand VBA row align code to align all sheets

Question

I'm working with an Excel report in which each month a new worksheet is added. Each row in the worksheet is for an employee, and the columns in that row is data related to them. Each week, the rows may vary, with names being added and removed.

I wrote the following VBA module to align the rows of 2 worksheets, adding blank rows as necessary, but I need to figure out a way to expand that so it aligns 12 worksheets, with multiple blank spaces between names as necessary. I'm not sure how to go about this, any suggestions?

Option Explicit

Sub Align()
Dim n As Long, a As Range, c As Range, x As Long
n = Cells.SpecialCells(11).Row
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200")
a(n + 1) = Chr(255): c(n + 1) = Chr(255)
a.Sort a(1), 1, Header:=xlNo
c.Sort c(1), 1, Header:=xlNo
Do
x = x + 1
If a(x) > c(x) Then
    a(x).EntireRow.Insert xlShiftDown
ElseIf a(x) < c(x) Then
    c(x).EntireRow.Insert xlShiftDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x) = Chr(255) And c(x) = Chr(255)
a(x).ClearContents: c(x).ClearContents
End Sub

Answer 1

I do not believe any simple rearrangement of your existing code will meet your needs. I also believe this is too big a question to expect anyone to create an entire macro for you.

Below I outline the approach I would take to solving your problem. I suggest you try to solve each issue in turn. None of the code I give has been tested so I doubt it is error-free. Debugging my code should help you understand it. If you run into difficulties, you can come back to me with questions. However, it would be better to attempt to construct a new question including the code you cannot get working. With a single issue question, I believe you will get help more quickly than waiting for me to log in.

I hope this helps.

Issue 1 - Identifying the 12 worksheets

If the workbook only contains the 12 worksheets "Jan", "Feb" ... "Dec", then it is easy: worksheets 1 to 12. It does not matter if they are in the wrong sequence.

If the workbook contains other worksheets that are the first few worksheets of the workbook then it will be almost as easy: N to N+11.

If the other worksheets and the month worksheets are muddled, you will have to access then using an approach like this:

Dim InxMonth As Long
Dim InxWsht As Long
Dim WshtMonthName() As Variant

WshtMonthName = Array("Jan", "Feb", ... "Dec)

For InxMonth = 0 to 11
  InxWsht = WshtMonthName(InxMonth)

  With Worksheets(InxWsht)
    :::::::
  End with
Next

It might be better to use this approach anyway in case a user adds a new worksheet. This technique will work regardless of what other worksheets may exist.

Issue 2 - Get sorted list of names

You need a list in alphabetic order containing every name that appears in any worksheet. I can think of a number of approaches. I was taught: get the code working then make it faster, smoother or whatever. I have picked an approach that I think is easy to implement. Other approaches would be faster to execute but it does not sound as though you will be executing the code very often and there are only 12 worksheets. Your taking hours to debug complex code that will shave a few seconds off the run time is not a good use of your time.

Issue 3 - Sort the worksheets

You have code to sort a single worksheet. You need to put that code in a loop which you execute for each of the month worksheets.

Issue 4 - Create list of names

This approach is not very elegant and I can think of much faster approaches. However I think it is easy to understand what this code is doing.

I have initialised NameList to 200 entries because your code seem to assume that there are fewer than 200 employees. However the code enlarges the array if necessary.

Dim InxNameCrntMax as Long
Dim InxMonth As Long
Dim InxWsht As Long
Dim NameList() As String
Dim NextLowestName As String
Dim RowCrnt As Long
Dim WshtRowCrnt() As Long

ReDim NameList(6 to 200)    ' 6 is first data row
InxNameCrntMax = 0

ReDim WshtRowCrnt(0 To 11)
' For each worksheet set the current row to the first data row
For InxMonth = 0 to 11
  WshtRowCrnt(InxMonth) = 6
Next

Do While True
  ' Loop until every name in every worksheet has been added to NameList

  NextLowestName = "~"    ' Greater than any real name      

  ' Examine the next row in each worksheet and find the lowest name
  For InxMonth = 0 To 11
    With Worksheets(WshtMonthName(InxMonth))
      RowCrnt = WshtRowCrnt(InxMonth)   ' Get next row for current worksheet
      If .Cells(RowCrnt, "A") <> "" Then
        ' Not all names from current worksheet added to NameList
        If NextLowestName > .Cells(RowCrnt, "A") Then
          ' This name comes before previous next lowest name
          NextLowestName = .Cells(RowCrnt, "A")
        End If
      End If
    End With
  Next        

  If NextLowestName = "~" Then
    ' All names from all worksheets added to NameList
    Exit Do
  End If

  ' Add NextLowestName to NameList
  InxNameCrntMax = InxNameCrntMax + 1
  If InxNameCrntMax > UBound(NameList) Then
    ' NameList is full so enlarge it
    ReDim Preserve NameList(6 To UBound(NameList) + 100)
  End If
  NameList(InxNameCrntMax) = NextLowestName

  ' Step the current row for every worksheet containing NextLowestName
  For InxMonth = 0 To 11
    With Worksheets(WshtMonthName(InxMonth))
      RowCrnt = WshtRowCrnt(InxWsht)   ' Get next row for current worksheet
      If .Cells(RowCrnt, "A") = NextLowestName Then
        WshtRowCrnt(InxWsht) = RowCrnt + 1
      End If
    End With
  Next

Loop

Issue 5 - Using NameList

I initialised the size of NameList to (6 To 200) although it may have been enlarged so it could now be (6 To 300) or (6 To 400).

VBA is one of the few languages that does not require the lower bound of an array to be 0. It is worth taking advantage of this feature. I understand from your code that 6 is the first data row of the worksheets. That is why I set the lowest bound to 6; it means the element numbers match the row numbers.

InxNameCrntMax is the last used entry in NameList so we have something like:

NameList(6) = "Aardvark, Mary"
NameList(7) = "Antelope, John"
NameList(8) = "Bison, Jessica"
  ::::::
NameList(InxNameCrntMax) = "Zebra, Andrew"

So if for Worksheets("Jan") there is no Mary Aardvark, row 6 should be empty. If there is a John Antelope, his data belongs on row 7.

In your code, you use InsertRow to insert blank lines. I do not really like updating worksheets in situ because, if you mess up, you have to reload the data from a backup copy.

I would rather build worksheet "JanNew" from Jan", "FebNew" from "Feb" and so on. When all these new worksheets had been created, I would rename "Jan" to "JanOld" and so on and then I would rename "JanNew" to "Jan" and so on. Only when I was absolutely convinced I had moved the data correctly would I delete the old worksheets.

However, I have to admit your approach is easier. I leave you to decide what to do.