VBA Loop Evaluates Cell, Copy & Paste it above Current Row, If Criteria is met

[JohnnyBconfused]

I'm a novice when it comes to VBA, and I have a list of names in Excel 2013 (Running Windows 8.1) and I want to write code that will generate and include all nicknames the person might have, so that if a user enters some variation - it will still be recognized. For example Richard would have the nicknames "Rich", "Rick", "D---". I want the code to add the additional names above the line of code that it is evaluating. I expected the code I currently have to copy and paste the row being evaluated into the newly created row(s) above. I planned to learn how to change the names later - and am currently doing it by hand. Unfortunately I'm getting a run-time error 1004 "application-defined or object-defined error", at "Rows("i:i").Select". I would like all the names to stay in the same spreadsheet. Can this be accomplished?

I've checked many examples here & on stack overflow, but none fit my use case & most send the rows to another sheet / workbook... Below is my code:

Sub insertnicknamerows()



Dim First, i, j,k,h


    For i = 1 To Rows.Count
        First = Split(Cells(i, 1).Value, " ")(0)
'this list grabs assigns the first name to the variable    



        If First = "Joe" Then
            j = i + 1
        
        
            Rows("i:i").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Rows("j:j").Select
            Selection.Copy
            Rows("i:i").Select
            ActiveSheet.Paste
            i = j
            
        ElseIf First = "Richard" Then
            j = i + 1
            k = i + 2
            h = i + 3
            
            
            Rows("i:i").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Rows("h:h").Select
            Selection.Copy
            Rows("i:i").Select
            ActiveSheet.Paste
            Rows("j:j").Select
            ActiveSheet.Paste
            Rows("k:k").Select
            ActiveSheet.Paste
        
            i = h
        
        End If
        
    Next i
End Sub

 

[RudiS]

Hi,

Welcome to the forum...

Would it be possible to post a representation of your data? A table representing the data you want to process, or a picture or even better, upload a sample workbook to Dropbox or OneDrive and provide a link to the shared file...

It would be much easier to assist you with something more visual or graphical to work with.

TX

 

[JohnnyBconfused]

Hi RudiS,

I've just created a file with the same type of data I'm working with in GoogleSheets - here's the link: https://docs.google.com/spreadsheets/d/1MscS9Ry2_FsBxFLXlI0falUWF70XHu4nirDv43B1zoA/pubhtml

Thanks!

 

[RudiS]

TX...

I have scanned your code and I can see you are inserting blank rows above the names if they meet a condition. Where will I get this condition and how many blank rows must be inserted if the condition is true?

Please clarify. TX

 

[JohnnyBconfused]

Hi RudiS,

I actually don't want to insert blank rows. If the name is "Richard Branson", I want to insert rows above that, that contain: "Rich Branson", "Rick Branson", & "D--- Branson"

I was going to code them into either a long if statement, or a select cases statement. Different names will need different numbers of rows (ex: Joe only has the alternative of Joseph, but Richard has alternatives of Rich & Rick & D--- and therefore it needs 3 rows to be added). If you could show me one example of how to code it so that "Richard" in a row, will generate 3 rows above with "Rich" & "Rick" & "D---k" as the first name - then I can write out the if / case statements. I don't understand how to instruct excel to do the first piece.






Thanks!

 

[RudiS]

Hi,

I would approach it differently.
The nickname variations I'd put into a sheet in the workbook and hide the sheet.
The code would then reference the sheet to find the actual name and extract the nicknames to the right of it (see example table below)
This way would be FAR easier to maintain the names and nicknames, adding, editing, adding more variations and referencing than to have all that in code. It will keep the code shorter and running faster too.

If you agree with this I can assist with the code...

Excel 2012
	A	B	C	D	E	F	G	H
1	Actual Name	NickN 1	NickN 2	NickN 3	NickN 4
2	John	Joe	JJ
3	Jane	J	Joey	Sweetheart :)
4	Bob	Bo	BB
5	Tom	Tommy	Mr. T
6	Michael	Mickey	Mike
7	George	Gorge	Porgy	Pudding	Pie
8	Bill	Bo	Billy
9
10	VBA will reference col A and find the actual name vertically
11	Once the name is found, it can offset to the right and collect each name as listed in the row
12
13
Nicknames

 

[JohnnyBconfused]

Wow - that will be exponentially easier to maintain / update Yes - how can this be done?

Thank You!

 

[RudiS]

Cool!
I'll post some code as soon as I can...

 

[RudiS]

Hi,

Here is a sample workbook with the code you need.
I trust this is more or less what you were needing...

Sample workbook with macro.

 

[RudiS]

Ignore the link above...

Here is an updated and improved version that will remove the nicknames and rebuild the list if you make changes (editions, deletions and added nicknames. It clears the nickname build in the master list and rebuilds it to incorporate the modifications to the nickname list...

Updated workbook and code.