<tbody>
[TD="class: votecell"][/TD]
[TD="class: postcell"] I work with a resourcing ledger which is also used for other financial purposes. As a result of the financial phases each resource in the file is split over 4-5 rows. What I would like to do is create a macro which finds their start date and corresponding end date on the next few rows and combines them whilst deleting the other rows and dates in between which show the interim date.
Another twist is that the file also holds roles yet to be fulfilled and are therefore just simply TBC.
I also need to do the same for the TBCs but instead will use the name of the role rather than the resource name to do the deletion of in between dates I have no idea how to go about this
So far I have created the following macros which goes through the dates and as long as they are in ldest to newest order - will seek out the lines which follow on from the original line. It does not however combine the start and final end date
Sub LoopRange3()
'Start at the currently selected cell
x = ActiveCell.Row
y = x + 1
'Outside loop
Do While Cells(x, 1).Value <> ""
'Inside loop
Do While Cells(y, 1).Value <> ""
'Test for duplication:
'If the values of the third column (C) and the fifth column (E) match in two rows
'delete the second row of the pair, otherwise go to the next row until the end
If (Cells(x, 3).Value = Cells(y, 3).Value) _
And (Cells(x, 5).Value = Cells(y, 5).Value) _
And (Cells(x, 7).Value = Cells(y, 7).Value) _
And (Cells(x, 9).Value = Cells(y, 9).Value) _
And (Cells(x, 10).Value = Cells(y, 10).Value) _
And (Cells(x, 13).Value <> Cells(y, 13).Value) _
And (Cells(y, 13).Value >= Cells(x, 14).Value) _
Then
'FOR DUPLICATE DELETION: Uncommment the following line by removing the apostrophe
'Cells(y, 3).EntireRow.Delete
'Shade the entire row green if it's a duplicate
'FOR DUPLICATE DELETION: Make the following line a comment by adding an apostrophe
Cells(y, 3).EntireRow.Interior.ColorIndex = 3
Else
'FOR DUPLICATE DELETION: Uncomment the following line by removing the apostrophe
End If
'FOR DUPLICATE DELETION: Make the following line a comment by adding an apostrophe
y = y + 1
Loop
'increase the value of x by 1 to move the loop starting point to the next row
x = x + 1
'reset y so it starts at the next row
y = x + 1
Loop
End Sub
any help would be great
[/TD]
</tbody>
