Button to move rows to other tab

[Stacie Fugate]

I've got a spreadsheet where I've created a button and when it's clicked it
will move the current row to the appropriate tab and insert it there instead
of replacing it. It also deletes the old row. Now, for my question
regarding this:

My spreadsheet is divided up into 3 sections. For the sake of simplicity,
I'll just call them Well Type 1, Well Type 2 and Well Type 3. They are laid
out like this:

WELL TYPE 1 INFORMATION
Smith #1 County ST 1/13/05
Jones #2 County ST 1/14/05

WELL TYPE 2 INFORMATION
Brown #3 County ST 1/16/05

WELL TYPE 3 INFORMATION
Haynes #6 County ST 1/17/05

Currently, under the last row of information under each section, there is an
add button that when clicked will add a new row (formatted as necessary with
borders and background cell color) under the specified section. My workbook
has 2 tabs, Western, and Tracking. Both of these tabs look exactly the same
(just like shown above), the only difference is the data that exists in each
section.

My question is this: now that I've got it set up to move the rows and
delete the old row, and it's working fine, how do I make excel move it to the
right section? If they click on a cell that falls under Well Type 2, and hit
the Move Row to Tracking Tab button, how can I make excel know to move it
under the Well Type 2 section of the Tracking Tab? How can it look for a
section title and know to insert it under that section? Also, if it inserts
the row, will it keep the appropriate formatting???

I'm not all that great with vba, but am learning quickly. Any help is
greatly appreciated!

Stacie

[Chip]

Stacie let me make sure I understand what is going...so Well Type 1,
Well Type 2 and Well Type 3 data sections are all on the same sheet?
and the number of rows in each section varies i am assuming? and you
want it so that when the active cell is in some range vba will act on
the corresponding well type, and then initiate your macro, correct?
can you give me your code thus far?

[Lonnie M.]

Chip, it might be worth taking a look at the other 4 post's on this to
get up to speed.

http://groups-beta.google.com/group/...ce19b07feddfcd
adding row when user reaches the last available empty row
I've got a spreadsheet where I've created a button and when it's
clicked it will
move the current row to the appropriate tab and insert it there instead
of ...
microsoft.public.excel.programming - Jan 27, 8:15 am by Stacie Fugate -
19 messages - 3 authors

http://groups-beta.google.com/group/...98d92a1c56ec90
Button to move rows to other tab
I've got a spreadsheet where I've created a button and when it's
clicked it will
move the current row to the appropriate tab and insert it there instead
of ...
microsoft.public.excel.programming - Jan 27, 8:13 am by Stacie Fugate -
2 messages - 2 authors

http://groups-beta.google.com/group/...19fba8e8afd215
Button to move row and delete old row
Okay... I've worked on this and got everything so far working
perfectly.
I've created the button and when it's clicked it will move ...
microsoft.public.excel.programming - Jan 27, 8:13 am by Stacie Fugate -
13 messages - 3 authors

http://groups-beta.google.com/group/...4d7900041f63d9
Automate Cut & Paste Rows to different tab in Workbook
I have an excel workbook that has 2 tabs with almost identical
spreadsheets
(one for a log of information, one for tracking data). ...
microsoft.public.excel.programming - Jan 20, 9:11 am by Stacie Fugate -
1

Regards, Lonnie M.

[Stacie Fugate]

You've got it correct so far. Currently, I have one button at the top of the
form that when clicked, it will insert the current row to the top of Section
1, because that's the cell it is designated to move to (A4) (under the header
rows) on the Tracking tab. It works fine if you are trying to move a row
from Section 1 of the Western Tab, to Section 1 of the Tracking Tab.
However, if your current row is in Section 2, and you click the button, it
will move it to Section 1 on the Tracking Tab.

The code I have behind the button right now is:

Private Sub MoveRow_Click()
ActiveCell.EntireRow.Copy
Worksheets("Tracking").Activate 'the other sheet
ActiveSheet.Range("A4").Select
Selection.Insert Shift:=xlDown
Worksheets("Western").Activate 'back to the original
ActiveCell.EntireRow.Delete Shift:=xlShiftUp
End Sub

Any help you can provide is greatly appreciated.

Thanks so much!
Stacie



"Chip" wrote:

> Stacie let me make sure I understand what is going...so Well Type 1,
> Well Type 2 and Well Type 3 data sections are all on the same sheet?
> and the number of rows in each section varies i am assuming? and you
> want it so that when the active cell is in some range vba will act on
> the corresponding well type, and then initiate your macro, correct?
> can you give me your code thus far?
>
>

[Chip]

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

[Stacie Fugate]

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
>
>

[Stacie Fugate]

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
>
>

[Chip]

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).

[Stacie Fugate]

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).
>
>