Hi All,
I'm a bit of a beginner so this is out of my limits. Creating a project tracking sheet that is as automted as possible so that people dont have to populate lots. I have managed to get it to create a new sheet and populate according to a filled out combobox. The user then populates a 'milestone' section. When a button is clicked these are transferred to a GANTT chart type sheet and pasted. Before they are pasted the macro checks if the project title exists, if it does not it first pastes the title LEFT INDENTED. Then follows by pasting the milestones CENTRED. If the title exists, it inserts the milestones under the project title by copying and pasting all milestones. Hence, if milestones are regularly added, it will begin to add duplicates of the same milestone. I need to remove these. I would usually be able to do this however there is often the same milestone in numerous projects which I CANNOT remove as it would loose data. I would like a code that says between the cell I was searching for (Rng) and the next cell which is also left indented to remove duplicates. Basically I can't use x1enddown because it needs to stop at the next cell which has the same formatting... i.e. only duplicates to be removed out of the cells which are centred. I would then like it to repear this action for the whole document and move the next left indented cell and do the same.
It feels like a kind of backward conditional formatting is what I am looking for
Any advice would be amazing.
Here is my code as it stands
Dim FindString As String
Dim Rng As Range
FindString = Range("D2").Value
If Trim(FindString) <> "" Then
With Sheets("Milestones").Range("A:A")
Set Rng = .Find(what:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
MsgBox "Project already exists in milestones - any additional milestones will be added"
Sheets("milestones").Activate
Rng.Select
If LastWorksheet <> "" Then
Worksheets(LastWorksheet).Activate
End If
Range("B19:F19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Milestones").Activate
Rng.Offset(1, 0).Select
Selection.Insert shift:=xlDown
Else
Range("D2").Activate
ActiveCell.Copy
Sheets("Milestones").Select
Range("A5").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If LastWorksheet <> "" Then
Worksheets(LastWorksheet).Activate
End If
Range("B19:F19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Milestones").Activate
Rng.Offset(1, 0).Select
Selection.Insert shift:=xlDown
End If
End With
End If
End Sub
Bookmarks