Adding extra info

[mickygoalie]

Hi
I am using Excel 2010
I have imported data from our database at work looking at employee training records for certain courses. In total I am looking at 5 courses but most employees have not completed all of them (I only see a record if they have completed the course). I need to create a line for each employee for each course.

Below is a sample of the data I have, and for example I would like to add an extra 3 rows to Adrian Kennard JAMCP001, JAMCP002 and JAMCPC101 with no date in the final column.

Any help would be appreciated. thanks

ADRIAN KENNARD​ ​ ​ ​ ​	JAM Birmingham​ ​ ​ ​ ​	JAMCPC003​ ​ ​ ​ ​	21/04/2012​ ​ ​ ​ ​
ADRIAN KENNARD​ ​ ​ ​ ​	JAM Birmingham​ ​ ​ ​ ​	JAMCPC102​ ​ ​ ​ ​	09/02/2013​ ​ ​ ​ ​
ADRIAN PARKER​ ​ ​ ​ ​	JAM Treforest​ ​ ​ ​ ​	JAMCPC001​ ​ ​ ​ ​	24/04/2010​ ​ ​ ​ ​
ADRIAN PARKER​ ​ ​ ​ ​	JAM Treforest​ ​ ​ ​ ​	JAMCPC002​ ​ ​ ​ ​	16/04/2011​ ​ ​ ​ ​

<TBODY> </TBODY>

 

[MARK858]

There are probably much better ways of doing this but try the codes below. The only difference between them is that the second code has an input box for the name.

Sub MICKEY1()
    Dim i As Long
    i = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(What:="ADRIAN KENNARD", After:=Cells(1, 1), LookIn:= _
                                                                  xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Cells(i, 1).Offset(1).Resize(3).EntireRow.Insert
    Range(Cells(i, 1), Cells(i, 2)).AutoFill Destination:=Range(Cells(i, 1), Cells(i + 3, 2)), Type:=xlFillDefault
    Cells(i + 1, 3).Value = "JAMCP001"
    Cells(i + 2, 3).Value = "JAMCP002"
    Cells(i + 3, 3).Value = "JAMCPC101"
End Sub

Sub MICKEY2()
    Dim i As Long, myName As String
    myName = InputBox("Enter Full name to Search", "Name of Employee")
    i = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(What:=myName, After:=Cells(1, 1), LookIn:= _
                                                                  xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Cells(i, 1).Offset(1).Resize(3).EntireRow.Insert
    Range(Cells(i, 1), Cells(i, 2)).AutoFill Destination:=Range(Cells(i, 1), Cells(i + 3, 2)), Type:=xlFillDefault
    Cells(i + 1, 3).Value = "JAMCP001"
    Cells(i + 2, 3).Value = "JAMCP002"
    Cells(i + 3, 3).Value = "JAMCPC101"
End Sub

 

[MARK858]

Just a bit more user friendly with a few more input boxes

Sub MICKEY3()
    Dim i As Long, myName As String, RowNo As Long
    RowNo = InputBox("Enter Number of Rows", "Rows")
    myName = InputBox("Enter Full name to Search", "Name of Employee")
    i = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(What:=myName, After:=Cells(1, 1), LookIn:= _
                                                                  xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Cells(i, 1).Offset(1).Resize(3).EntireRow.Insert
    Range(Cells(i, 1), Cells(i, 2)).AutoFill Destination:=Range(Cells(i, 1), Cells(i + RowNo, 2)), Type:=xlFillDefault
    For i = i + 1 To i + RowNo
        Cells(i, 3).Value = InputBox("Row " & i, "Enter Text")
    Next
End Sub

 

[MARK858]

Just noticed an omission in the last code.
the line below

[LEFT][COLOR=#333333][SIZE=2]Cells(i, 1).Offset(1).Resize(3).EntireRow.Insert

should read[/SIZE]
[/COLOR][/LEFT]

Cells(i, 1).Offset(1).Resize(RowNo).EntireRow.Insert

 

[mickygoalie]

Hi Mark858
Thanks for this, I haven't tried it yet. But I will have a look today, I don't know that much about VBA but I'll try

 

[MARK858]

When you have tried the posted code. Post back and let me know if you normally have to put in the same details in column C for different names. If you do then it is probably better to have a userform.
If it is the case then I will put a variation together when I get in later

 

[MARK858]

Duplicate post