Insert Rows

Hello:

I have excel sheet with name of Clients in Column B starting from cell B2 and goes on until B300
I want to insert 2 rows in between each client and name those cell as A & B and format it to the right of the cell.

Example as below:

Cell B2 : John Doe
B3 : Alen Smith
B4 : Wes Barb

change above to :

B2 : John Doe
B3 : A
B4 : B
B5 : Alen Smith
B6 : A
B7 : B
B8 : Wes Barb
B9 : A
B10: B
and so on..
Please let me know if any questions.

Thanks

RM

Hello:

I do not think that would work for me since i have 300 rows of clients and need to add rows inbetween client names.

Please help with VB Code to perform the task.

Thanks

RM

Hello Riz,

I have added a button to "Sheet2" to run the macro below. This will copy the data, add the needed rows, and right align the two newly added rows for each entry.

Please Login or Register  to view this content.

PHP Code: 

Option Explicit
Sub gpeMacro()
 Dim Cls As Range
 Dim Rws As Long:                           Dim MyStr As String
 
 Columns("A:A").Select:                     Selection.Insert Shift:=xlToRight
 Rws = Cells(Rows.Count, "C").End(xlUp).Row
 Cells(Rws, "A").Value = "GPE.COM":         Cells(1, "A").Value = "GPE.COM"
 
 For Each Cls In Range("C2:C" & Rws)
    MyStr = "A" & Cls.Row:                  Cls.Offset(, -2).Value = MyStr
    With Cells(Rows.Count, "A").End(xlUp).Offset(1)
        .Value = MyStr & "A":               .Offset(, 2).Value = "A"
        .Offset(1).Value = MyStr & "B":     .Offset(1, 2).Value = "B"
        .Offset(, 2).Resize(2).HorizontalAlignment = xlRight
    End With
 Next Cls
 Columns("A:C").Select
 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1
 Columns("A:A").Delete
End Sub 


Hello Riz,

You're welcome.