Same workbook, different problem.
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 |
Same workbook, different problem.
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 Erik wrote: 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 -- Dave Peterson |
Same workbook, different problem.
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 |
Same workbook, different problem.
|
Same workbook, different problem.
You may want to look at the comments in my last post. (or not!)
Erik wrote: Dave, Thank you for the code. You may disregard my last post. After some thought, I figured out how to do what I wanted. Realize that I am self taught and it sometime takes me a while to figure out the code. Thanks again. Erik -- Dave Peterson |
All times are GMT +1. The time now is 12:34 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com