Macro, Find move over a cell paste input with loop

[psrs0810]

I am trying to do a find, move over a cell then paste the needed title. the problem I am having is, what I trying to find is listed 2x's. so finding the first one I am good with. I can't get the macro to find the second one.

Cells.Find(What:="A Total", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Value = "ASSISTANCE"

Cells.Find(What:="B Total", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Value = "BLUE"

So I have A Total, B Total, etc listed 2x's in column B.

I tried added a loop to this, but it is not working.
How do I find "A Total" move over to the cell on the right and put "Assistance", then find the next A Total?

 

[mikerickson]

The Find is looking for "A Total", the second Find is looking for "B Total"

What is it that is listed twice?

 

[psrs0810]

"A Total" is listed twice, "B Total" is listed twice, "C Total" is listed twice, etc

 

[Dryver14]

Sub FindIt()
Dim i As Long
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Cells(i, 1).Value = "A Total" Then Cells(i, 2) = "ASSISTANCE"
If Cells(i, 1).Value = "B Total" Then Cells(i, 2) = "BLUE"

Next i
End Sub

You will need to add a line for each "Total" responce you want

 

[hiker95]

psrs0810,


Sample raw data before the macro:

Excel Workbook
	A	B
1	Title A	Title B
2
3		A Total
4
5		B Total
6
7		A Total
8
9		A Total
10
11		B Total
12
13		B Total
14
Sheet1

After the macro:

Excel Workbook
	A	B
1	Title A	Title B
2
3	ASSISTANCE	A Total
4
5	BLUE	B Total
6
7	ASSISTANCE	A Total
8
9	ASSISTANCE	A Total
10
11	BLUE	B Total
12
13	BLUE	B Total
14
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub FindABTotals()
' hiker95, 04/13/2011
' http://www.mrexcel.com/forum/showthread.php?t=543393
Dim c As Range, firstaddress As String
Application.ScreenUpdating = False
With Columns(2)
  Set c = .Find("A Total", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      c.Offset(, -1) = "ASSISTANCE"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
  firstaddress = ""
  Set c = .Find("B Total", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      c.Offset(, -1) = "BLUE"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
End With
Application.ScreenUpdating = True
End Sub

Then run the FindABTotals macro.



If the macro does not work correctly, then can we have a screenshot of your worksheet?[/u


To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net

 

[psrs0810]

Dryver14 I tried using your code and it skipped right over the totals

 

[Dryver14]

It worked for me but looking at Hikers code I amy be looking in the wrong column if the ToTals are in column be then it should read

Sub FindIt()
Dim i As Long
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To FinalRow
If Cells(i, 2).Value = "A Total" Then Cells(i, 3) = "ASSISTANCE"
If Cells(i, 2).Value = "B Total" Then Cells(i, 3) = "BLUE"

Next i
End Sub

 

[psrs0810]

that was it and it worked perfectly - thanks!!!

I forgot that the 1 and 2 were referencing the columns

 

[hiker95]

psrs0810,

I missed the offset - now fixed. And, the below macro code will work faster then looping thru all the cells in column B.


Sample data before the macro:

Excel Workbook
	B	C
1	Title B	Title C
2
3	A Total
4
5	B Total
6
7	A Total
8
9	A Total
10
11	B Total
12
13	B Total
14
Sheet1

After the macro:

Excel Workbook
	B	C
1	Title B	Title C
2
3	A Total	ASSISTANCE
4
5	B Total	BLUE
6
7	A Total	ASSISTANCE
8
9	A Total	ASSISTANCE
10
11	B Total	BLUE
12
13	B Total	BLUE
14
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub FindABTotals()
' hiker95, 04/13/2011
' http://www.mrexcel.com/forum/showthread.php?t=543393
Dim c As Range, firstaddress As String
Application.ScreenUpdating = False
With Columns(2)
  Set c = .Find("A Total", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      c.Offset(, 1) = "ASSISTANCE"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
  firstaddress = ""
  Set c = .Find("B Total", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      c.Offset(, 1) = "BLUE"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
End With
Application.ScreenUpdating = True
End Sub

Then the FindABTotals macro.

 

[mikerickson]

Perhaps a loop like

Sub test()
    Dim aFound As Range, bFound As Range
    Dim aMarker As String, bMarker As String
    Dim firstFoundAddress As String, bLastRow As Long
    
    aMarker = "A Total": bMarker = "B Total"
    
    With Columns(2)
        Set aFound = .Find(What:=aMarker, After:=.Cells(.Rows.Count, 1), _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    
        If aFound Is Nothing Then MsgBox "No A": Exit Sub
        Set bFound = aFound
        firstFoundAddress = aFound.Address
        
        Do
            Set bFound = .Find(What:=bMarker, After:=bFound, _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not bFound Is Nothing Then
                If aFound.Row < bFound.Row And bLastRow < bFound.Row Then
                    aFound.Offset(0, 1) = "A"
                    bFound.Offset(0, 1) = "B"
                End If
                bLastRow = bFound.Row
            End If

            Set aFound = .Find(What:=aMarker, After:=aFound, _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Loop While aFound.Address <> firstFoundAddress
        
    End With
End Sub