trouble with Selection.Find

rholdren

Board Regular
Joined
Aug 25, 2016
Messages
82
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
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,411
Since there are many "selects" in the code, "select" is very seldom needed, could you explain what you want to do.
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,411
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
 

rholdren

Board Regular
Joined
Aug 25, 2016
Messages
82
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
31,977
Office Version
365
Platform
Windows
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
 

rholdren

Board Regular
Joined
Aug 25, 2016
Messages
82
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
31,977
Office Version
365
Platform
Windows
Glad you got it sorted & thanks for the feedback
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,411
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
 

Forum statistics

Threads
1,081,523
Messages
5,359,263
Members
400,523
Latest member
ExcelNewbie98

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top