Macro to Move Data Within a Row if Criteria is Met

Hello all,

Trying to write a macro that will move and delete info within rows based on certain criteria.

In the Title column (marked in the row 1 header), if there are two titles that match and are sequential, the following happens:
- On the row containing the first instance of the duplicate title, the dates in the HB Start Date and HB End Date columns are moved into the Start Date and End Date columns (replace any existing data in these cells). The data in the Hdate and Gdate columns in this row is deleted.
- On the row below this (containing the second instance of the duplicate title), delete the Gdate, HB Start Date, HB End Date, and Hdate data in this row.

In the example attached, Title2 is a duplicate, so the macro will move the data in the two rows for Title2:

Would need to loop through several thousand rows. The columns are not always in the same column letters, which is why I’d like to use the header in row 1 to identify the columns. Also, there may be instances of triple titles that match. In this case, do nothing – the macro should only move dates if it finds only two sequential titles. If there are more than this in the Title column, then do nothing.

Please let me know if there are any questions. Help is most appreciated on this – thank you!

Question also posed at Mr. Excel: http://www.mrexcel.com/forum/showthread.php?t=535105

Hi Watersev,

Thanks for your help on this - looks like it works almost perfectly. The only thing is, could the macro just make the changes all on one sheet instead of opening a new sheet?

Sorry if my original post was confusing, but i'd like the macro to perform the calculations all on one sheet.

Thank you again!

hi, I've amended the code to process correctly triple occurances in a row, the result is on the same sheet

Also, looks like the macro has references to specific cell letters. If I try moving around the column order, it does not delete the correct rows/columns. Is there any way to write this so it uses the headers in row 1 as the identifier for each column (as opposed to specific cell letters) so the columns can be in any order?

Again, thanks so much for the help!

the code has no cell references at all, as soon as the whole table will be in another place the code will work correctly, see attachment

I see what you mean, the table may have different order of headers, I'll change the code for you but only tomorrow if no one will do that instead of me

Thanks Watersev, I appreciate the help.

I have attached a larger file - this is what I'm actually working with. Just trying to figure out the coding so it performs the functions based on the header in row 1 (and can add columns or the columns can be in a different order). Let me know if you have any questions. In the meantime, I'll keep working with your original code to see if I can come up with a solution.

Hi Watersev,

Any chance you would be able to help out with changing the code? Appreciate the help, thanks.

hi, please check attachment, run the code "test", hope this helps. Though I do not like the code it looks it does what you need.

Thanks so much watersev!! I believe this works perfectly. Can't thank you enough.

if you are happy with the outcome, please mark the thread as solved (see Forum rules for details)

Code might look something like this, but can't quite get it to work..


Option Explicit
Sub moverows3()
Dim iTitlerow As Long, iTitlecol As Integer, iGdatecol As Integer, iHBStartDatecol As Integer, iHBEndDatecol As Integer, iStartDatecol As Integer, _
iEndDatecol As Integer, iHdatecol As Integer, myrange, firstrow, secondrow, thirdrow, i As Long, x As Integer, y As Integer, z As Integer

With ActiveSheet: On Error Resume Next: Application.ScreenUpdating = False
iTitlerow = .UsedRange.Find("Title", , xlValues, xlWhole).Row: iTitlecol = .UsedRange.Find("Title", , xlValues, xlWhole).Column
iGdatecol = .UsedRange.Find("Gdate", , xlValues, xlWhole).Column
iHBStartDatecol = .UsedRange.Find("HB Start Date", , xlValues, xlWhole).Column
iHBEndDatecol = .UsedRange.Find("HB End Date", , xlValues, xlWhole).Column
iStartDatecol = .UsedRange.Find("Start Date", , xlValues, xlWhole).Column
iEndDatecol = .UsedRange.Find("End Date", , xlValues, xlWhole).Column
iHdatecol = .UsedRange.Find("Hdate", , xlValues, xlWhole).Column
Set myrange = Range(.Cells(iTitlerow, iTitlecol, iTitlerow), .Cells(iTitlerow, iTitlecol).End(xlDown))
For i = 3 To myrange.Cells.Count
If myrange(i).Offset(1, 0).Value = myrange(i).Value Then x = 1
If myrange(i).Offset(2, 0) = myrange(i).Value Then y = 1
If myrange(i).Offset(3, 0) = myrange(i).Value Then z = 1
If x = 1 And y = 0 And z = 2 Then
.Cells(myrange(i).Row, iStartDatecol) = .Cells(myrange(i).Row, iHBStartDatecol)
.Cells(myrange(i).Row, iEndDatecol) = .Cells(myrange(i).Row, iHBEndDatecol)
Set firstrow = Union(Cells(myrange(i).Row, iGdatecol), Cells(myrange(i).Row, iHBStartDatecol), Cells(myrange(i).Row, iHBEndDatecol), Cells(myrange(i).Row, iHdatecol))
Set secondrow = Union(Cells(myrange(i).Row, iGdatecol), Cells(myrange(i).Row, iHBStartDatecol), Cells(myrange(i).Row, iHBEndDatecol), Cells(myrange(i).Row, iHdatecol))
Set thirdrow = Union(Cells(myrange(i).Row + 2, iGdatecol), Cells(myrange(i).Row + 2, iHBStartDatecol), Cells(myrange(i).Row + 2, iHBEndDatecol), Cells(myrange(i).Row + 2, iStartDatecol), Cells(myrange(i).Row + 2, iEndDatecol), Cells(myrange(i).Row + 2, iHdatecol))
Union(firstrow, secondrow, thirdrow).ClearContents
i = i + 1
ElseIf x = 1 And y = 1 And x = 1 Then
i = i + 2
End If
x = 0: y = 0
Next
End With: Application.ScreenUpdating = True: End Sub

your posts 13-14 violate Forum rules on the part of posting code, please amend

see attachment

sorry, just posted a revised code. please see post #14

Nevermind, just saw your new post - thanks for the help!!

I'll check it now and mark the post solved