trouble with Selection.Find

rholdren

Board Regular
Joined
Aug 25, 2016
Messages
140
Office Version
  1. 365
  2. 2019
the code below works fine until it no longer finds what I am looking for (example is AR)

When it has found the last of "AR" I get an error to debug and the section from Selection.find to False).Activate is highlighted yellow. Any help would be really appreciated.

Sub ARK_DEP()
For i = 1 To 200
Sheets("Departures").Select
Columns("E:E").Select
Selection.Find(What:="AR", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, -4).Select
ActiveCell.Select
ActiveCell.Select
ActiveCell.Resize(, 10).Select
'Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Sheets("Arkansas").Select
ActiveSheet.Select
Range("J4:S200").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveSheet.Paste


Next i



End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Since there are many "selects" in the code, "select" is very seldom needed, could you explain what you want to do.
 
Upvote 0
This will stop at the last found "AR".
Example code by Luke M
Code:
Dim c As Range 
Dim firstAddress As String 
With Range("A:A") 
    Set c = .Find("bob") 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
             'here you do something
            Set c = .FindNext(c) 
        Loop Until c.Address = firstAddress 
    End If 
End With
 
Upvote 0
I have a spreadsheet that has departure information from 4 states (AR,OH,TN,TX) and I need to pull the departure information for each state out and cut and past to a Tab designated with that state. Example
read the column with the state abbreviation then highlight the entire line cut that data from the departures page and paste it in the next available cell on the state page. It all works until I get to the end of AR (or OH,TN,TX) and then I run into an error.
 
Upvote 0
Is this what you need
Code:
Sub CopyPaste()

   Dim Info As String
   Dim Ary As Variant
   Dim usdRws As Long
   
   Info = "AR|Arkansas|OH|[COLOR=#ff0000]???[/COLOR]|TN|[COLOR=#ff0000]???[/COLOR]|TX|[COLOR=#ff0000]???[/COLOR]"
   Ary = Split(Info, "|")
   
   With Sheets("Departures")
      usdRws = .Range("A" & Rows.Count).End(xlUp).Row
      For Cnt = LBound(Ary) To UBound(Ary) Step 2
         If .AutoFilterMode Then .AutoFilterMode = False
         .Range("A1:J1").AutoFilter 5, Ary(Cnt)
         .Range("A2:J" & usdRws).SpecialCells(xlVisible).Copy _
            Worksheets(Ary(Cnt + 1)).Range("J" & Rows.Count).End(xlUp).Offset(1)
      Next Cnt
      .AutoFilterMode = False
   End With

End Sub
Replacing values in red with the sheet names
 
Upvote 0
Thanks everybody. I found a different way to approach this. I took some code from something I wrote last year that goes out and reads the line and deletes the entire row when <> the value. I really appreciate you all looking into this.

If (Cells(i, "E").Value) <> "AR" Then
Cells(i, "E").EntireRow.Delete
End If
 
Upvote 0
Glad you got it sorted & thanks for the feedback
 
Upvote 0
Here is another way. Not knocking your way, just another way.
If I understand your last post right, you copy the "Master" into the four sheets and delete that what is not needed.
This should be easier. Try it on a copy of your workbook.
Assumes you have a headers in the Columns first Row
Also assumes that the sheets are named the same as the abbreviations. If not, let us know.
Before transferring, it'll clear the sheets with the abbreviated names from A2 on down.

Code:
Sub rholden()
Dim c As Range, shArr, j As Long, lc As Long
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
shArr = Array("AR", "OH", "TN", "TX")

    Application.ScreenUpdating = False
    
    For j = LBound(shArr) To UBound(shArr)
        Sheets(shArr(j)).UsedRange.Offset(1).Delete Shift:=xlUp    'ClearContents
    Next j
    
    For Each c In Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row)
        c.Offset(, -4).Resize(, lc).Copy Sheets(c.Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next c
    
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top