Macro for variable rows (fruit flies)
 

When I go back to school I have to take biology. Fruit flies takes half the
year. I want to have an Excel program in place that will cut down the time
as I have an after school job.

I need to be able to choose a row with a certain dominant or recessive
attribute then follow it for five generations (five rows). I would also like
to backtrack it for three generations (three rows).

What I need to figure out is how do I make a "floater" macro where I can
select a five column row (or however many attributes the teacher selects)
anywhere in the column and have it put each of the eight rows in their
respective generational column?

This is what I have so far:
Sub AnInsert()
'
' AnInsert Macro
' Macro recorded 6/21/2008 by Lisa
'

'
Range("B9:F9").Select
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B10:F10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("AE1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B11:F11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("BG1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B12:F12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("CI1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B13:F13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("DK1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B7:F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("EM1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("FO1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B5:F5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("GQ1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Range("C1:C6").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("AE1:AE6").Select
Selection.Insert Shift:=xlDown
Range("BG1:BG6").Select
Selection.Insert Shift:=xlDown
Range("CI1:CI6").Select
Selection.Insert Shift:=xlDown
Range("DK1:DK6").Select
Selection.Insert Shift:=xlDown
Range("EM1:EM6").Select
Selection.Insert Shift:=xlDown
Range("FO1:FO6").Select
Selection.Insert Shift:=xlDown
Range("GQ1:GQ6").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
End Sub

I think I may have to use the R1C1 thing and I've been reading up on it. I
haven't figured out the ROWs thing either. The 3 generations back will
probably be a minus from the selected row and the 5 generations following
will probably be pluses.

The attribute may be in the next generation or may not be. But every row it
shows up in I need to list in a generation column.

The actual row that the attribute is in, is B8:F8 but it will change from
row to row as it shows up in following generations.

He has us work in groups, then halfway through we copy our info and give it
to the other groups. We put it all together and then each group has to write
a paper. So we end up with columns and columns of info.

Thanks in advance.

--
Lisa

Macro for variable rows (fruit flies)
 

So your original data is always in columns B:F and you go up 3 rows and down an
additional 4 (plus the current row) for a total of 8 rows.

Then you paste each row (only columns B:F) in certain spots.

Because you used windows (:1 and :2) in your code, I can't tell what worksheet
gets the pasted values. But you'll know.

And I couldn't tell where each row got pasted. But if you know the top left
corner of each row that gets pasted, you can modify this code.

Option Explicit
Sub testme()

Dim RngToCopy As Range
Dim SelectedCell As Range
Dim AddrToPaste As Variant
Dim pCtr As Long
Dim RptWks As Worksheet
Dim myRow As Range

Set RptWks = ActiveWorkbook.Worksheets("OtherSheet")
'one address for each row (top left corner to paste
'each row
AddrToPaste = Array("A1", "B2", "C3", "D4", "E5", "F6", "G7", "H8")

If UBound(AddrToPaste) - LBound(AddrToPaste) + 1 < 8 Then
MsgBox "Design error--the number of addresses " _
& "don't match the number of rows!"
Exit Sub
End If

Set SelectedCell = Nothing
On Error Resume Next
Set SelectedCell = Application.InputBox _
(Prompt:="Select a cell in the ""main"" row", Type:=8) _
.Cells(1)
On Error GoTo 0

If SelectedCell Is Nothing Then
Exit Sub 'user hit cancel
End If

If SelectedCell.Row < 3 Then
MsgBox "Not enough rows to grab previous generations!"
Exit Sub
End If

If Intersect(SelectedCell, _
SelectedCell.Parent.UsedRange.EntireRow) Is Nothing Then
MsgBox "Please select a cell where's there data!"
Exit Sub
End If

Application.ScreenUpdating = False

'up 3 rows and start in column B and resize to 8 rows by 5 columns
Set RngToCopy = SelectedCell.Offset(-3, 0).EntireRow.Cells(1) _
.Offset(0, 1).Resize(8, 5)

'MsgBox RngToCopy.Address 'just to check the address!

pCtr = LBound(AddrToPaste)
For Each myRow In RngToCopy.Rows
myRow.Copy
RptWks.Range(AddrToPaste(pCtr)).PasteSpecial Paste:=xlPasteValues
pCtr = pCtr + 1
Next myRow

With Application
.ScreenUpdating = True
.CutCopyMode = False
End With

End Sub



Lisa Anne wrote:

When I go back to school I have to take biology. Fruit flies takes half the
year. I want to have an Excel program in place that will cut down the time
as I have an after school job.

I need to be able to choose a row with a certain dominant or recessive
attribute then follow it for five generations (five rows). I would also like
to backtrack it for three generations (three rows).

What I need to figure out is how do I make a "floater" macro where I can
select a five column row (or however many attributes the teacher selects)
anywhere in the column and have it put each of the eight rows in their
respective generational column?

This is what I have so far:
Sub AnInsert()
'
' AnInsert Macro
' Macro recorded 6/21/2008 by Lisa
'

'
Range("B9:F9").Select
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B10:F10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("AE1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B11:F11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("BG1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B12:F12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("CI1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B13:F13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("DK1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B7:F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("EM1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("FO1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Windows("Fruit Flies 101.xls:1").Activate
Range("B5:F5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fruit Flies 101.xls:2").Activate
Range("GQ1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Range("C1:C6").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("AE1:AE6").Select
Selection.Insert Shift:=xlDown
Range("BG1:BG6").Select
Selection.Insert Shift:=xlDown
Range("CI1:CI6").Select
Selection.Insert Shift:=xlDown
Range("DK1:DK6").Select
Selection.Insert Shift:=xlDown
Range("EM1:EM6").Select
Selection.Insert Shift:=xlDown
Range("FO1:FO6").Select
Selection.Insert Shift:=xlDown
Range("GQ1:GQ6").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
End Sub

I think I may have to use the R1C1 thing and I've been reading up on it. I
haven't figured out the ROWs thing either. The 3 generations back will
probably be a minus from the selected row and the 5 generations following
will probably be pluses.

The attribute may be in the next generation or may not be. But every row it
shows up in I need to list in a generation column.

The actual row that the attribute is in, is B8:F8 but it will change from
row to row as it shows up in following generations.

He has us work in groups, then halfway through we copy our info and give it
to the other groups. We put it all together and then each group has to write
a paper. So we end up with columns and columns of info.

Thanks in advance.

--
Lisa

--

Dave Peterson

Macro for variable rows (fruit flies)
 

One of the things you can do is change the .screenupdating = false to true near
the top. Then you can step through the code using the F8 key.

This will allow you to look at what's happening on the worksheet that's being
pasted.

Try it against a test workbook to see what it does -- when/if you're happy, try
it against a workbook with real data.

There are lots of good books.

Debra Dalgleish has a list of books at her site:
http://www.contextures.com/xlbooks.html

John Walkenbach's books are very good to start.


Lisa Anne wrote:

Wow. I'm embarrassed. The macro I wrote only worked the one time and then
it wouldn't work again. You were right about the worksheets. I'm sorta
computer literate, but mostly the internet. My Aunt has this neat book Excel
2003 Formulas by John Walkenback that I am trying to use to figure out Excel.
I rewrote the macro and it will do it all the time now, but just the one
place.

B8:F8 is the current row. The top 3 rows are blank and the 4th row has the
titles.

My cousin took biology last year and the fruit fly project drove him nuts.
Microscope time is limited. So one person looks at the fly while someone
else writes it down. Then another member puts it into the computer. I just
want to make the collection of information easier and faster to put together.
Otherwise the cut and paste takes forever.

I'm trying to get it organized. You are right about the current row. I
didn't think about that because I'm only interested in the 3 rows previous
and the five rows after the current row. I probably do need to put it in
there. Have to check with my cousin on that one. Thanks for the input.

We put the information in columns so we can determine what characteristics
and attributes show up the most often and which ones they are paired with the
most often.

Here is what the new macro looks like:

Sheets("Rev").Select
Range("B9:F9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B10:F10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("AE1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B11:F11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("BG1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B12:F12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("CI1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B13:F13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("DK1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B7:F7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("EM1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("FO1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Rev").Select
Range("B5:F5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("GQ1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Range("C1:C6").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("AE1:AE6").Select
Selection.Insert Shift:=xlDown
Range("BG1:BG6").Select
Selection.Insert Shift:=xlDown
Range("CI1:CI6").Select
Selection.Insert Shift:=xlDown
Range("DK1:DK6").Select
Selection.Insert Shift:=xlDown
Range("EM1:EM6").Select
Selection.Insert Shift:=xlDown
Range("FO1:FO6").Select
Selection.Insert Shift:=xlDown
Range("GQ1:GQ6").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
End Sub

I'm gonna have to read a lot to figure out how your macro works so I can
make changes. Do you know what books I will need to read? The macros are
written with Visual Basic, right?

Thank you so much!!!!!!!

--
Lisa

"Dave Peterson" wrote:

So your original data is always in columns B:F and you go up 3 rows and down an
additional 4 (plus the current row) for a total of 8 rows.

Then you paste each row (only columns B:F) in certain spots.

Because you used windows (:1 and :2) in your code, I can't tell what worksheet
gets the pasted values. But you'll know.

And I couldn't tell where each row got pasted. But if you know the top left
corner of each row that gets pasted, you can modify this code.

Option Explicit
Sub testme()

Dim RngToCopy As Range
Dim SelectedCell As Range
Dim AddrToPaste As Variant
Dim pCtr As Long
Dim RptWks As Worksheet
Dim myRow As Range

Set RptWks = ActiveWorkbook.Worksheets("OtherSheet")
'one address for each row (top left corner to paste
'each row
AddrToPaste = Array("A1", "B2", "C3", "D4", "E5", "F6", "G7", "H8")

If UBound(AddrToPaste) - LBound(AddrToPaste) + 1 < 8 Then
MsgBox "Design error--the number of addresses " _
& "don't match the number of rows!"
Exit Sub
End If

Set SelectedCell = Nothing
On Error Resume Next
Set SelectedCell = Application.InputBox _
(Prompt:="Select a cell in the ""main"" row", Type:=8) _
.Cells(1)
On Error GoTo 0

If SelectedCell Is Nothing Then
Exit Sub 'user hit cancel
End If

If SelectedCell.Row < 3 Then
MsgBox "Not enough rows to grab previous generations!"
Exit Sub
End If

If Intersect(SelectedCell, _
SelectedCell.Parent.UsedRange.EntireRow) Is Nothing Then
MsgBox "Please select a cell where's there data!"
Exit Sub
End If

Application.ScreenUpdating = False

'up 3 rows and start in column B and resize to 8 rows by 5 columns
Set RngToCopy = SelectedCell.Offset(-3, 0).EntireRow.Cells(1) _
.Offset(0, 1).Resize(8, 5)

'MsgBox RngToCopy.Address 'just to check the address!

pCtr = LBound(AddrToPaste)
For Each myRow In RngToCopy.Rows
myRow.Copy
RptWks.Range(AddrToPaste(pCtr)).PasteSpecial Paste:=xlPasteValues
pCtr = pCtr + 1
Next myRow

With Application
.ScreenUpdating = True
.CutCopyMode = False
End With

End Sub

--

Dave Peterson