Generate a list without duplicated data and fill Start/End Date

[brunoicq]

Hi

Weekly I receive a schedule with merged and not merged cells.

I have to Copy/Paste the FIRST LINE of each Cell into Column C, without duplicate them, separated by PLACE (Column B), and put the START and END Date.

Can disconsider every cell that starts with IOT, FREE, CP or Férias

Please check the Final Result in Sheet Plan2

Maybe, part of solution is thread.php?53993 of this forum (I can't post links yet)

Thanks in advanced

[brunoicq]

PS: The order does not matter

[SamT]

I have to Copy/Paste the FIRST LINE of each Cell into Column C,

FIRST LINE of each [first Merged] Cell... first Merged Cells Only?


without duplicate them

See Rows 6 & 17 on sheet Plan2... They are duplicates.

[brunoicq]

Hi SamT,

First, thanks for the interest in helping me.

About your questions:


FIRST LINE of each [first Merged] Cell... first Merged Cells Only?
There are Merged cells (such as D3, E4, F7, etc) and Non-Merged cells (such as G3, H3, H4, I4, etc).


See Rows 6 & 17 on sheet Plan2... They are duplicates.
They are not duplicated because the PLACE is different (Column B). Row 6 is from RJ and Row 17 is from DF.

Any doubt, please, let me know.
thanks in advanced

[Leith Ross]

Hello brunoicq,

This macro should be close to what you need. It lists only projects whose cells have a gray background. These appear to match up with your list on the Plan2 worksheet.

The list of places on the worksheet Plan1 appear to be in ascending alphabetical order. The projects are stored in a Dictionary Object for easy access later. This object allows the place names to be in random on the sheet.

A button has been added to the Plan2 worksheet to run the macro. Let me know if this is close to what you need.



Sub ListProjects()

Dim Cell As Range
Dim col As Long
Dim colCnt As Long
Dim Data As Variant
Dim Dict As Object
Dim Headers As Range
Dim Item As Variant
Dim Key As Variant
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim row As Long
Dim Text As String
Dim Wks As Worksheet

Set Wks = Worksheets("Plan1")

col = Wks.Cells(2, Columns.Count).End(xlToLeft).Column
Set Headers = Wks.Range("C2").Resize(ColumnSize:=col - 3 + 1)

Set RngBeg = Headers.Offset(1, 0)
Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)

Set Rng = RngBeg.Resize(RowSize:=RngEnd.row - RngBeg.row + 1)

Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare

' Collect the data by Place, Start date and End date.
For row = 1 To Rng.Rows.Count
For col = 1 To Rng.Columns.Count
Set Cell = Rng.Cells(row, col)

colCnt = Cell.MergeArea.Columns.Count

n = InStr(1, Cell, vbLf)
If n > 0 Then Text = Left(Cell, n - 1) Else Text = Cell.Text

Text = Text & "|" & Headers(1, col) & "|" & Headers(1, col + colCnt - 1)

' Process only cells with gray back color.
If Cell.Interior.Color = RGB(214, 220, 228) Then
Key = Wks.Cells(Cell.row, "B").Text
Item = Text & "|"

If Not Dict.Exists(Key) Then
Dict.Add Key, Item
Else
Item = Dict(Key) & Text & "|"
Dict(Key) = Item
End If
End If

If Cell.MergeCells Then
col = col + colCnt - 1
End If
Next col
Next row

' Output the data to worksheet Plan2.
Set Wks = Worksheets("Plan2")

' Clear any previous data but no the headers.
Set Rng = Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0))
Rng.ClearContents

' Start output on row 2.
Set Rng = Wks.Range("B2:E2")

row = 0
For Each Key In Dict.Keys
Rng.Offset(row, 0).Cells(1, 1).Value = Key
row = row + 1

Data = Split(Dict(Key), "|")

For n = 0 To UBound(Data) - 1 Step 3
Rng.Offset(row, 1).Resize(1, 3).Value = Array(Data(n), Data(n + 1), Data(n + 2))
row = row + 1
Next n
Next Key

End Sub

[brunoicq]

Hello Leith Ross,

Yes, this macro is very close to what I need. It list the projects but with some duplicated results. I will work in it to improve the results.

Thanks a lot for your help

[Leith Ross]

<Duplicate Post>

[Leith Ross]

Hello brunoicq,

I did notice that the following duplication...

RJ



H367P Brasil OPEN QE3
15-out-15
15-out-15


H367P Brasil OPEN QE3
16-out-15
16-out-15




The start and end times are different on both. Since they occur for the same person, I was unsure of what you wanted to do.

[brunoicq]

Hello Leith,

In case of duplication, I have to merge them, keeping the older Start Date and the newer End Date. In this case, I should have only one result like bellow:|
RJ


H367P Brasil OPEN QE3
15-out-15
16-out-15




Please, consider triplication in different rows such as:
RJ


H450T Brasil OPEN QE2
13-out-15
13-out-15





H450T Brasil OPEN QE2
15-out-15
15-out-15





H450T Brasil OPEN QE2
16-out-15
16-out-15





In this case, the result should be:


H450T Brasil OPEN QE2
13-out-15
16-out-15

[wardex]

Leith Ross so nice : ) . how did you learn to create that code or scripts?