Button to move rows to other tab

Give this a shot:

Sub Copier()
Dim currentcell As Integer
currentcell = ActiveCell.Row
currentcolumn = ActiveCell.Column

Range("A1").Select
Dim Titler As String

'Find rows of titles.



For i = 3 To 1 Step -1
Titler = "WELL TYPE " & i & " INFORMATION"

Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Dim intcounter As Integer
intcounter = ActiveCell.Row

If currentcell > intcounter Then
sectionnumber = i
i = 1
Else
End If

Next i

Cells(currentcell, currentcolumn).Select
ActiveCell.EntireRow.Copy
Worksheets("Tracking").Activate 'the other sheet
Titler = "WELL TYPE " & sectionnumber & " INFORMATION"
Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown
Worksheets("Western").Activate 'back to the original
ActiveCell.EntireRow.Delete Shift:=xlShiftUp


End Sub

Should it look like what is below? When I copied and pasted it, this is the
code that I have, and it didn't work right.. not sure why not though.

Private Sub MoveRow_Click()
Sub Copier()
Dim currentcell As Integer
currentcell = ActiveCell.Row
currentcolumn = ActiveCell.Column

Range("A1").Select
Dim Titler As String

'Find rows of titles.



For i = 3 To 1 Step -1
Titler = "WELL TYPE " & i & " INFORMATION"

Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Dim intcounter As Integer
intcounter = ActiveCell.Row

If currentcell > intcounter Then
sectionnumber = i
i = 1
Else
End If

Next i

Cells(currentcell, currentcolumn).Select
ActiveCell.EntireRow.Copy
Worksheets("Tracking").Activate 'the other sheet
Titler = "WELL TYPE " & sectionnumber & " INFORMATION"
Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown
Worksheets("Western").Activate 'back to the original
ActiveCell.EntireRow.Delete Shift:=xlShiftUp

End Sub



"Chip" wrote:

> Give this a shot:
>
> Sub Copier()
> Dim currentcell As Integer
> currentcell = ActiveCell.Row
> currentcolumn = ActiveCell.Column
>
> Range("A1").Select
> Dim Titler As String
>
> 'Find rows of titles.
>
>
>
> For i = 3 To 1 Step -1
> Titler = "WELL TYPE " & i & " INFORMATION"
>
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> Dim intcounter As Integer
> intcounter = ActiveCell.Row
>
> If currentcell > intcounter Then
> sectionnumber = i
> i = 1
> Else
> End If
>
> Next i
>
> Cells(currentcell, currentcolumn).Select
> ActiveCell.EntireRow.Copy
> Worksheets("Tracking").Activate 'the other sheet
> Titler = "WELL TYPE " & sectionnumber & " INFORMATION"
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> ActiveCell.Offset(1, 0).Select
>
> Selection.Insert Shift:=xlDown
> Worksheets("Western").Activate 'back to the original
> ActiveCell.EntireRow.Delete Shift:=xlShiftUp
>
>
> End Sub
>
>

You know what? I think I did something thinking that it wouldnt make much
difference, however, it is making a difference in the code... For simplicity
sake, I just told you that my section titles were "Well Type 1 Information",
"Well Type 2 Information" and "Well Type 3 Information". The actual names of
my sections are: "Well Name", "Exploratory Wells", and "Upcoming Notables".
I believe that's making a difference in the code, other than just changing
the names... am I correct?

"Chip" wrote:

> Give this a shot:
>
> Sub Copier()
> Dim currentcell As Integer
> currentcell = ActiveCell.Row
> currentcolumn = ActiveCell.Column
>
> Range("A1").Select
> Dim Titler As String
>
> 'Find rows of titles.
>
>
>
> For i = 3 To 1 Step -1
> Titler = "WELL TYPE " & i & " INFORMATION"
>
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> Dim intcounter As Integer
> intcounter = ActiveCell.Row
>
> If currentcell > intcounter Then
> sectionnumber = i
> i = 1
> Else
> End If
>
> Next i
>
> Cells(currentcell, currentcolumn).Select
> ActiveCell.EntireRow.Copy
> Worksheets("Tracking").Activate 'the other sheet
> Titler = "WELL TYPE " & sectionnumber & " INFORMATION"
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> ActiveCell.Offset(1, 0).Select
>
> Selection.Insert Shift:=xlDown
> Worksheets("Western").Activate 'back to the original
> ActiveCell.EntireRow.Delete Shift:=xlShiftUp
>
>
> End Sub
>
>

Try this:

Sub Copier()
Dim currentcell As Integer
currentcell =3D ActiveCell.Row
currentcolumn =3D ActiveCell.Column


Range("A1").Select
Dim titler As String
Dim notableslocation As Integer
Dim exploratorylocation As Integer
Dim wellnamelocation As Integer

'Find rows of titles.

Cells.Find(What:=3D"Upcoming Notables", After:=3DActiveCell,
LookIn:=3DxlFormulas, LookAt:=3DxlPart, SearchOrder:=3DxlByRows,
SearchDirection:=3DxlNe=ADxt, MatchCase:=3DFalse).Activate
notableslocation =3D ActiveCell.Row

Cells.Find(What:=3D"Exploratory Wells", After:=3DActiveCell,
LookIn:=3DxlFormulas, LookAt:=3DxlPart, SearchOrder:=3DxlByRows,
SearchDirection:=3DxlNe=ADxt, MatchCase:=3DFalse).Activate
exploratorylocation =3D ActiveCell.Row

Cells.Find(What:=3D"Well Name", After:=3DActiveCell, LookIn:=3DxlFormulas,
LookAt:=3DxlPart, SearchOrder:=3DxlByRows, SearchDirection:=3DxlNe=ADxt,
MatchCase:=3DFalse).Activate
wellnamelocation =3D ActiveCell.Row

Select Case currentcell
Case Is > notableslocation
titler =3D "Upcoming Notables"
Case Is > exploratorylocation
titler =3D "Exploratory Wells"
Case Is > wellnamelocation
titler =3D "Well Name"
End Select
Cells(currentcell, currentcolumn).Select
ActiveCell.EntireRow.Copy
Worksheets("Tracking").Activate 'the other sheet
Cells.Find(What:=3Dtitler, After:=3DActiveCell, LookIn:=3DxlFormulas,
LookAt:=3DxlPart, SearchOrder:=3DxlByRows, SearchDirection:=3DxlNext,
MatchCase:=3DFalse).Activate
ActiveCell.Offset(1, 0).Select
Selection.Insert Shift:=3DxlDown
Worksheets("Western").Activate 'back to the original
ActiveCell.EntireRow.Delete Shift:=3DxlShiftUp
End Sub


And yes the title names did matter, because my macro there searches for
the names of the sections so the ranges of each section can be changed
(i.e you can add/delete rows in each section and it wont matter).

For some reason, this still isn't working right... I've uploaded the file to
my webspace, you can go to the link below to view it... maybe actually seeing
the file will help... I appreciate all your help very much!

http://members.cox.net/stacie.fugate...ments-COPY.xls

Thanks again,
Stacie

"Chip" wrote:

> Try this:
>
> Sub Copier()
> Dim currentcell As Integer
> currentcell = ActiveCell.Row
> currentcolumn = ActiveCell.Column
>
>
> Range("A1").Select
> Dim titler As String
> Dim notableslocation As Integer
> Dim exploratorylocation As Integer
> Dim wellnamelocation As Integer
>
> 'Find rows of titles.
>
> Cells.Find(What:="Upcoming Notables", After:=ActiveCell,
> LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
> SearchDirection:=xlNeÂÂ*xt, MatchCase:=False).Activate
> notableslocation = ActiveCell.Row
>
> Cells.Find(What:="Exploratory Wells", After:=ActiveCell,
> LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
> SearchDirection:=xlNeÂÂ*xt, MatchCase:=False).Activate
> exploratorylocation = ActiveCell.Row
>
> Cells.Find(What:="Well Name", After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNeÂÂ*xt,
> MatchCase:=False).Activate
> wellnamelocation = ActiveCell.Row
>
> Select Case currentcell
> Case Is > notableslocation
> titler = "Upcoming Notables"
> Case Is > exploratorylocation
> titler = "Exploratory Wells"
> Case Is > wellnamelocation
> titler = "Well Name"
> End Select
> Cells(currentcell, currentcolumn).Select
> ActiveCell.EntireRow.Copy
> Worksheets("Tracking").Activate 'the other sheet
> Cells.Find(What:=titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
> MatchCase:=False).Activate
> ActiveCell.Offset(1, 0).Select
> Selection.Insert Shift:=xlDown
> Worksheets("Western").Activate 'back to the original
> ActiveCell.EntireRow.Delete Shift:=xlShiftUp
> End Sub
>
>
> And yes the title names did matter, because my macro there searches for
> the names of the sections so the ranges of each section can be changed
> (i.e you can add/delete rows in each section and it wont matter).
>
>