Same workbook, different problem.

E

Erik

I have sheet1 with info in cells G2 to CI37. Row1 contains column headers for events to be completed. Even numbered rows from 2 to 36 will contain the date of completion for the event in that column. I need excel to find the last cell in each of the even numbered rows with a date entered and determine the event (row1,column-last date entered). Then, place the last event completed for each even numbered row in a column in sheet2. Ex: Row2 has dates in the cells in columns G thrugh M corresponding to events 1-7. Therefore place the label event7 in cell B1 of sheet2. Row4's last date is in column K so place label event5 in cell B2 of sheet2. Etc.
Also, if either all cell are empty or all cells filled with dates, make the corresponding cell in sheet2 empty.
As always, any help is greatly appreciated.
Erik
 
D

Dave Peterson

I _think_ that this does what you want. It finds that last cell in the even
numbered rows and plops it into the first open row (starting at the bottom) in
column B.

Option Explicit
Sub testme01()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("CI1").Column

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
'do nothing
Else
If IsEmpty(.Cells(iRow, LastCol)) = False Then
Set myCell = .Cells(iRow, LastCol)
Else
If IsEmpty(.Cells(iRow, LastCol - 1)) = False Then
Set myCell = .Cells(iRow, LastCol - 1)
Else
Set myCell = .Cells(iRow, LastCol).End(xlToLeft)
End If
End If

With tWks
Set DestCell _
= .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
End With
'move the stuff
DestCell.Value = .Cells(1, myCell.Column)
'move the date, too????
DestCell.Offset(0, -1).Value = myCell.Value
End If
Next iRow
End With

End Sub

But maybe this is closer. It takes the even numbered rows and puts them in the
same order
(row 2 to 36 goes to rows 1 to 18 on sheet2):

Option Explicit
Sub testme02()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range
Dim myValToMove As Variant

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("CI1").Column

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
Set myCell = Nothing
Else
If IsEmpty(.Cells(iRow, LastCol)) = False Then
Set myCell = .Cells(iRow, LastCol)
Else
If IsEmpty(.Cells(iRow, LastCol - 1)) = False Then
Set myCell = .Cells(iRow, LastCol - 1)
Else
Set myCell = .Cells(iRow, LastCol).End(xlToLeft)
End If
End If
End If

If myCell Is Nothing Then
myValToMove = ""
Else
myValToMove = .Cells(1, myCell.Column)
End If

With tWks
Set DestCell = .Cells(iRow / 2, "B")
End With

'move the stuff
DestCell.Value = myValToMove

Next iRow
End With

End Sub

I wasn't sure.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
E

Erik

Dave,
I played around with the code you suggested and got it to do what I wanted with one exception. If all the cells in a row are empty or all are full, I want to make the corresponding cell in sheet2 empty as well. I got the all full part to work, but can't seem to figure out the all empty one. The following is what I have so far. Any suggestions would be greatly appreciated.
Erik

Dim fWks As Worksheet
Dim iRo As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range

Set fWks = Worksheets("Tracker")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("Y1").Column

For iRo = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRo, FirstCol), .Cells(iRo, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
'do nothing
Else
If IsEmpty(.Cells(iRo, LastCol)) = False Then
Sheets("infotest").Cells((iRo / 2) + 3, 10) = ""
Else
If IsEmpty(.Cells(iRo, LastCol - 1)) = False Then
Set myCell = .Cells(iRo, LastCol - 1)
Else
Set myCell = .Cells(iRo, LastCol).End(xlToLeft)
End If
End If

Sheets("infotest").Cells((iRo / 2) + 3, 10) = .Cells(1, myCell.Column)

End If
Next iRo
End With
 
D

Dave Peterson

This is the way I did it in the second version (did you notice that one?)

(This time with some comments intermingled.)

Option Explicit
Sub testme03()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range
Dim myValToCopy As Variant

Set fWks = Worksheets("Tracker")

'I like a single spot to hold the worksheet name.
'if the name changes, I just fix it once.
'and by using a variable declared as a Worksheet, I get the VBA's
'intellisense to pop up when I hit that dot (like in twks. <--).
Set tWks = Worksheets("infotest")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("Y1").Column

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
'if they're all filled or all empty
'then make the cell to copy "Nothing"
'we'll check for that later.
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
Set myCell = Nothing '<--
Else
'but if they're not all empty, start looking for the last one
If IsEmpty(.Cells(iRow, LastCol)) = False Then
Set myCell = .Cells(iRow, LastCol)
Else
If IsEmpty(.Cells(iRow, LastCol - 1)) = False Then
Set myCell = .Cells(iRow, LastCol - 1)
Else
Set myCell = .Cells(iRow, LastCol).End(xlToLeft)
End If
End If
End If
'notice that this "end if" got moved up and we'll always check
'to see what to move--either "" or the real value.

'now check to see what we found.
'if I'm not supposed to copy anything, mycell will be nothing
'else it'll be the value of what's in row 1 of that
mycell.column.
If myCell Is Nothing Then
myValToCopy = ""
Else
myValToCopy = .Cells(1, myCell.Column)
End If

'plop it in!
tWks.Cells((iRow / 2) + 3, 10) = myValToCopy

Next iRow
End With

End Sub

Now, one question. Why did you change the iRow variable to iRo? Just curious.
 
D

Dave Peterson

and watch out for linewrap!
'now check to see what we found.
'if I'm not supposed to copy anything, mycell will be nothing
'else it'll be the value of what's in row 1 of that
mycell.column.
If myCell Is Nothing Then
Click to expand...


That mycell.column should be on the previous line.
 
Top