Autopopulate cells based on a list in another worksheet

[Dallie]

Hi all,

First time poster, long time user.

Could somebody please help me with a macro that I would be far out of my depth with, and would help me save a plenty of writing long words in the future. I deal with a lot of plant samples from day to day and about 10,0000 need to be entered over the next couple of years into a spreadsheet document

What I need is a running worksheet macro that searches a list in another worksheet when i input certain species names and then automatically enters a name in the next column. The macro needs to automatically propagate the family name when the species name has been entered.

I'm thinking for this to work: when a species name (column A "Sheet1") has been entered it needs to automatically compare the first word of Column A "Sheet1" against the list in column B of "Sheet2" and if the Genus name is matches the first word in the species name then it automatically enters the family name in column B "Sheet1".

The only other step that would need to be introduced is a quality assurance step that if the first word of the species name does not match any Genus in "Sheet2" then the cell should populate with a check of the species name (e.g. Not a valid species name).

Here is a tiny example of what I need below:

"Sheet1" "Sheet2"
[TABLE="width: 600"]
<tbody>[TR]
[TD="align: center"]Column A[/TD]
[TD="align: center"]Column B[/TD]
[TD][/TD]
[TD="align: center"]Column A[/TD]
[TD="align: center"]Column B[/TD]
[/TR]
[TR]
[TD]Species name[/TD]
[TD]Auto_propagate Family name[/TD]
[TD][/TD]
[TD]Family Name[/TD]
[TD]Genus[/TD]
[/TR]
[TR]
[TD]Prunus americana[/TD]
[TD][/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Malus[/TD]
[/TR]
[TR]
[TD]Citrus aurantium[/TD]
[TD][/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Prunus[/TD]
[/TR]
[TR]
[TD]Prnus domesticus[/TD]
[TD][/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Rubus[/TD]
[/TR]
[TR]
[TD]Citrus grandis[/TD]
[TD][/TD]
[TD][/TD]
[TD]Rutaceae[/TD]
[TD]Citrus[/TD]
[/TR]
</tbody>[/TABLE]

Once macro has been made:
"Sheet1" "Sheet2"
[TABLE="width: 600"]
<tbody>[TR]
[TD="align: center"]Column A[/TD]
[TD="align: center"]Column B[/TD]
[TD][/TD]
[TD="align: center"]Column A[/TD]
[TD="align: center"]Column B[/TD]
[/TR]
[TR]
[TD]Species name[/TD]
[TD]Auto_propagate Family name[/TD]
[TD][/TD]
[TD]Family Name[/TD]
[TD]Genus[/TD]
[/TR]
[TR]
[TD]Prunus americana[/TD]
[TD]Rosaceae[/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Malus[/TD]
[/TR]
[TR]
[TD]Citrus aurantium[/TD]
[TD]Rutaceae[/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Prunus[/TD]
[/TR]
[TR]
[TD]Prnus domesticus[/TD]
[TD]Not a valid species name[/TD]
[TD][/TD]
[TD]Rosaceae[/TD]
[TD]Rubus[/TD]
[/TR]
[TR]
[TD]Citrus grandis[/TD]
[TD]Rutaceae[/TD]
[TD][/TD]
[TD]Rutaceae[/TD]
[TD]Citrus[/TD]
[/TR]
</tbody>[/TABLE]


Sorry for the lack of code but I don't even know where to start with this one.

Any help is greatly appreciated.

Thanks Dallie

 

[Fluff]

Hi & welcome to MrExcel
How about

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim Fnd As Range
   
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
   With Sheets("Sheet2").Range("B2", Sheets("Sheet2").Range("B" & Rows.count).End(xlUp))
      Set Fnd = .find(Split(Target.Value, " ")(0), , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         Target.Offset(, 1).Value = Fnd.Offset(, -1).Value
      Else
         Target.Offset(, 1).Value = "Not a valid species name"
      End If
   End With
Application.EnableEvents = True
End Sub

This needs to go in the sheet module for "Sheet1"

 

[Dallie]

Oh my, how rude of me.. I forgot to thank you!

Thank you very much Fluff it works perfectly, great work!

 

[Fluff]

Glad to help & thanks for the feedback

 

[Dallie]

Hello again Fluff,

I have started using this in a couple of different sheets (and it is great thank you again!) but I was thinking about introducing this to an issues register that I use with my Co-workers. If I were to do this I would need to bug proof the code so that whatever they do they cannot break the code. So I am wondering on your thoughts of how I would bug proof this minor issue that I have with the macro (or really me breaking the macro) so that I could add this into the code?

Currently the macro is fine until I remove any one of the entries in column A (sheet 1) so that the cell is blank. When I do this I get this following issue "Run-time error '9'; Subscript out of range" error and it breaks the code unit I exit completely out of all excel workbooks and start them up again.

Do you have any thoughts on how to add a failsafe to the code so that if anyone removes text from one of the cells in column A (sheet 1) that the code will exit the sub rather than break it?

Your thoughts are greatly appreciated!!

 

[Fluff]

Add the line in red

If Target.Column <> 1 Then Exit Sub
[COLOR=#ff0000]If Len(Target.Value) = 0 Then Exit Sub[/COLOR]

 

[Dallie]

You are a legend!