VBA to find Value, then Name Cell

[OldDogNewTricks]

I want my code to do two things.
1) Locate the cells in Column A that have a certain value
2) Name the cells with that certain value

All the values will be in Column A. The word I am searching for will appear three different times in the column. I need a code that will find those cells and name them. I have tried multiple different angles, and I am not sure where I am going wrong. I greatly appreciate any help you can provide!

I have Excel 2007.

Example:
The following is supposed to represent Column A in my document. I am searching for cells that have the word "Bacon" in it. The code should name the first cell containing the word, "Bacon1." The next cell containing the word should be named "Bacon2." This continues until no more cells containing "Bacon" can be found and labeled.

Toppings
Bacon
Hamburger
Chicken
Peppers
Cheese
Meats
Bacon
Hamburger
Chicken
Extras
Sauce
Cheese
Bacon

 

[thatoneguy650]

A formula might be easier

=IF(A2="Bacon","Bacon" & COUNTIF($A$1:A2,"=Bacon"),"")

Otherwise here is a sub

Sub mrExcelBaconSearch()

Dim rng1 As Range
Dim strSearch As String
Dim i As Integer
Dim foundRow As Integer
Dim LastRow As Integer


LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
foundRow = 1
strSearch = "Bacon"
For i = 1 To 3


Set rng1 = Range("A" & foundRow & ":A" & LastRow).Find(strSearch, , xlValues, xlWhole)
If rng1.Row = LastRow Then
    rng1.Offset(0, 1).Value = strSearch & i
    foundRow = rng1.Row
    Exit Sub
Else
    rng1.Offset(0, 1).Value = strSearch & i
    foundRow = rng1.Row
End If


Next
End Sub

 

[Rick Rothstein]

I think this macro will do what you want...

Sub EnumeratedDefinedNamesForGivenWord()
  Dim Index As Long, Word As String, Cell As Range
  Word = InputBox("What word do you want to find and name?")
  If Len(Word) Then
    Columns("A").Replace Word, "#N/A", xlWhole
    On Error GoTo WordNotFound
    For Each Cell In Columns("A").SpecialCells(xlConstants, xlErrors)
      Index = Index + 1
      Cell.Name = Word & Index
    Next
  End If
  Columns("A").Replace "#N/A", Word, xlWhole
WordNotFound:
End Sub

 

[Rick Rothstein]

I think this macro will do what you want...

Sub EnumeratedDefinedNamesForGivenWord()
  Dim Index As Long, Word As String, Cell As Range
  Word = InputBox("What word do you want to find and name?")
  If Len(Word) Then
    Columns("A").Replace Word, "#N/A", xlWhole
    On Error GoTo WordNotFound
    For Each Cell In Columns("A").SpecialCells(xlConstants, xlErrors)
      Index = Index + 1
      Cell.Name = Word & Index
    Next
  End If
  Columns("A").Replace "#N/A", Word, xlWhole
WordNotFound:
End Sub

Actually, ignore the above code... while it works, this simpler approach make more sense to use.

Sub EnumeratedDefinedNamesForGivenWord()
  Dim X As Long, Index As Long, Word As String
  Word = InputBox("What word do you want to find and name?")
  If Len(Word) Then
    For X = 1 To Cells(Rows.Count, "A").End(xlUp).Row
      If Cells(X, "A").Value = Word Then
        Index = Index + 1
        Cells(X, "A").Name = Word & Index
      End If
    Next
  End If
End Sub

 

[OldDogNewTricks]

Thank you for your help! Rick's responses are more of what I am looking for because the entire cell is named versus a description to the right of the cell. I have two follow-up questions:

1. Is there a way to make the input box NOT case sensitive and ignore spaces? For instance, if the row looked like this:
TOPPINGS
.. Bacon
.. Hamburger
.. Cheese
I need to type in ". Bacon" instead of "Bacon" or "bacon" because there are spaces in front of Bacon and it is capitalized.

2. How do I name the entire row vs the cell?

Thanks again!

 

[OldDogNewTricks]

I figured out the solution to my second question! Very excited. I would still love help with my first one.

Here is the answer to my second question:
Private Sub CommandButton1_Click()
Dim X As Long, Index As Long, Word As String
Word = InputBox("What component do you want to find and name?")
If Len(Word) Then
For X = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(X, "A").Value = Word Then
Index = Index + 1
Rows(X).Name = Word & Index
End If
Next
End If
End Sub

 

[Rick Rothstein]

This revised code should do it for you (I highlighted the changes for Question #1 in blue so you can see what I added to make it work; you handled Question #2 on your own... nice going!)...

Sub EnumeratedDefinedNamesForGivenWord()
  Dim X As Long, Index As Long, Word As String
  Word = InputBox("What word do you want to find and name?")
  If Len(Word) Then
    For X = 1 To Cells(Rows.Count, "A").End(xlUp).Row
      If [COLOR=#0000ff][B]UCase(Trim([/B][/COLOR]Cells(X, "A").Value[COLOR=#0000ff][B]))[/B][/COLOR] = [COLOR=#0000ff][B]UCase([/B][/COLOR]Word[COLOR=#0000ff][B])[/B][/COLOR] Then
        Index = Index + 1
        Rows(X).name = Word & Index
      End If
    Next
  End If
End Sub

 

[OldDogNewTricks]

That works perfectly! Thank you so much!

 

[OldDogNewTricks]

I have another follow-up question. Is there a clause I can insert into the code, so it erases the row names in the Name Manager before naming the rows?

Reason:
Suppose cell A1 says "apples." I run the code, and it labels the row "Apples1." I rearrange my items, so now cell A1 says "Bacon." I rerun the code. Row 1 should be labeled "Bacon1," but it still says "Apples1."

 

[Rick Rothstein]

I think this will do that (added line highlighted in blue)...

Sub EnumeratedDefinedNamesForGivenWord()
  Dim X As Long, Index As Long, Word As String
  Word = InputBox("What word do you want to find and name?")
  If Len(Word) Then
    For X = 1 To Cells(Rows.Count, "A").End(xlUp).Row
      If UCase(Trim(Cells(X, "A").Value)) = UCase(Word) Then
        Index = Index + 1
         [COLOR=#0000FF][B]Rows(X).Name.Delete[/B][/COLOR] 
        Rows(X).Name = Word & Index
      End If
    Next
  End If
End Sub
[COLOR=#0000FF][/COLOR]