Help - Automatically Insert Rows in a List

P

peter.abing

New member
Joined
Oct 24, 2012
Messages
34
Reaction score
0
Points
0
Hi everyone,

I am an intermediate user of Excel. I know a little about Macros and I know how to use most of the formulas in Excel.
I want your help in a certain spreadsheet for reporting purposes.
Please see illustration in the attached Excel file.

The spreadsheet contains a list of employees and the projects where they have worked for a certain period.
What I want to do is sort the list of employees and insert a spacer (row) between each employee.
If possible, the row will be formatted.

I know this is possible with Excel because anything is possible in Excel.
I just don't know how to code this in VBA.

Thanks,
Peter
 

Attachments

  • Illustration.xlsx
    9.3 KB · Views: 17
You will need VBA code to do that. This code will first sort the data ascending then it will insert the blank rows to seperate employee ID.

Code: 
Sub InsertRowAtChangeInValue()

Columns("A:E").Select
    ActiveWorkbook.Worksheets("From").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("From").Sort.SortFields.Add Key:=Range("B2:B14"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("From").Sort
        .SetRange Range("A1:E14")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
 
 
 

Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Rows(lRow).EntireRow.Insert
Next lRow
End Sub
 
Thank you so much for your prompt reply tommyt61. This thing worked but I have to edit everytime I run this Macro.
How can I code this to make it universal. Like if I run this macro, I don't need to edit the tab name to "From" or the code itself from "From" to the tab name. I am thinking of ActiveWorksheets instead of Worksheets("From") but that did not work. I think this is not correct.
And there will be a prompt that will ask me what range I want to sort (each report that I want to sort has different number of rows and columns) and which column would be the basis for adding a spacer.

The steps I envision:
1. I make the sheet active and run the Macro. (Any sheet name, not just "From").
2. A prompt will ask me "What range do you want to apply this Macro with?". Then I select "A:E". Other reports will have more than 5 columns.
3. A prompt will ask me "Which column would you like the data sorted?". Then I would select "B2:B14". Others will have different range.
4. A prompt will ask me "Which column would you like to be the basis for the spacer?".

Could you please shed some light with this. This would really save me a minute per report because I will not have to edit the code.
The code above will already save me a lot of time for the whole process. Thanks to you.

Thanks,
Peter
 
Ken Puls said:
I think that would have to qualify as my favourite quote of the day. LOL! :)
Click to expand...
That is also my favorite line. Add to that, I also believe that your imagination is the limit of what Excel can do.
It's the most powerful and simple tool for PCs and Macs.
 
peter.abing said:
The steps I envision:
1. I make the sheet active and run the Macro. (Any sheet name, not just "From").
2. A prompt will ask me "What range do you want to apply this Macro with?". Then I select "A:E". Other reports will have more than 5 columns.
3. A prompt will ask me "Which column would you like the data sorted?". Then I would select "B2:B14". Others will have different range.
4. A prompt will ask me "Which column would you like to be the basis for the spacer?".
Click to expand...

The first is easy. You were close, it's Activesheet (singular). I've also modified Tommy's code a bit to use a bit more With blocking:
Code: 
Sub InsertRowAtChangeInValue()
    Dim lRow As Long
    With ActiveSheet
        .Columns("A:E").Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("B2:B14"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:E14")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Range("A1").Select
  
        For lRow = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row To 2 Step -1
          If .Cells(lRow, "A") <> .Cells(lRow - 1, "A") Then .Rows(lRow).EntireRow.Insert
        Next lRow
    End With
End Sub

With regards to the others...
2) Is is always all columns? If so there's no need to select anything, we can always pick up all columns with data in them.
3) Do you need to tell the macro which column needs to be sorted every time, or will it always be sorted by Employee ID? If so, will Emloyee ID always be spelled the same, and will it always be in the first column?
4) Is the spacer always based on Name? Again, could Name move to a different column?
 
2. Only columns with data need to be sorted.
3. I prefer to sort the data according to names alphabetically. And this is always the second column.
4. The spacer can be based on Names or Employee ID (just the same because each employee has unique ID).

Thank you so much for your help.
I really appreciate it.
 
Give this a go and see if it works correctly. I set it to always sort based on column B and put in the break based on B as well, since that column doesn't change. I also expanded it to work no matter how many columns you have.

Code: 
Sub InsertRowAtChangeInValue()
    Dim lRow As Long
    Dim lstCol As String
    
    With ActiveSheet
        lstCol = GetColLetter(.Range("A1").End(xlToRight))
        
        .Columns("A:" & lstCol).Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:" & ActiveSheet.Range(lstCol & ActiveSheet.Rows.Count).End(xlUp).Address)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Range("A1").Select
  
        For lRow = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row To 3 Step -1
          If .Cells(lRow, "B") <> .Cells(lRow - 1, "B") Then .Rows(lRow).EntireRow.Insert
        Next lRow
    End With
End Sub

Private Function GetColLetter(cl As Range) As String
    Dim tmp() As String
    tmp() = Split(cl.Address, "$")
    GetColLetter = tmp(1)
End Function
 
Thank you very much for all the help. I can now confirm that this is what I need. I just added some sorting codes because in my report, I need multiple levels of sorting.
Thank you very much Ken. Sorry for the delayed reply. It's a long weekend here in Dubai (Eid'l Adha) and my friends and I went somewhere.
 
You must log in or register to reply here.
Back
Top