Schedule Manager - Posting The Results

[TheRedCardinal]

Hi all,

I normally try to have a go at coding my problems but this one I am totally stumped by.

For background please see this thread which I solved myself:

Looking up values in arrays - how to handle if not present

I am working on a scheduling module which allows a user to set "available days" which would normally be work days (but not always). Once this is done, a set list of tasks is analysed and I want to allocate these tasks to those available days. My current code looks like this: Firstly the user...

www.mrexcel.com

However the next step is proving beyond me.

What I have at the end of the above thread is an array of variable size (1 dimension is 6, the other varies). I need the data from columns 1, 5 and 6.

In WS1 I have a list of possible working days probably in Column A. The values in columns 5 and 6 must match those values (they are numbers corresponding to dates)

So for example in line in my array might be:

Task 1; x; x; x; 19; 22

What I need to do is paste the text of "Task" 1 into column B next to the date that it matches, like this:

Then the next task might look like this:

Task 2; x; x; x; 19; 23

This then needs to go UNDERNEATH the current task linked to 19 on a new row, which would look like this: (23 goes into its own row obviously):

The macro would loop through all 60 odd tasks allocating them as so, and then once that has been done, would find all matching dates and merge them into one cell like this:

Finally it would then colour all alternate rows (based on date) different shades for easy viewing.

I'm going to have a go at coding it but I'm lacking that starting point as to how to proceed!

 

[TheRedCardinal]

I really should learn to have a go before giving up.

This seems to work nicely, though I had to shift the row insertion from below to above. I can easily achieve the same result by changing my For Counter section to starting at the UBound and going in -1 steps.

Dim PasteRow As Long

With WS1

    For Counter = 1 To UBound(JobsArray)
    
        PasteRow = Application.WorksheetFunction.Match(JobsArray(Counter, 5), .Range("A:A"), 0)
        
        If .Cells(PasteRow, 2) = "" Then
            .Cells(PasteRow, 2) = "Prepare " & JobsArray(Counter, 1)
        Else
            .Rows(.Cells(PasteRow, 2).Row).Insert shift:=xlDown
            .Cells(PasteRow, 2) = "Prepare " & JobsArray(Counter, 1)
            .Cells(PasteRow, 1) = JobsArray(Counter, 5)
        End If
        
        PasteRow = Application.WorksheetFunction.Match(JobsArray(Counter, 6), .Range("A:A"), 0)
        
        If .Cells(PasteRow, 2) = "" Then
            .Cells(PasteRow, 2) = "Submit " & JobsArray(Counter, 1)
            
        Else
            .Rows(.Cells(PasteRow, 2).Row).Insert shift:=xlDown
            .Cells(PasteRow, 2) = "Submit " & JobsArray(Counter, 1)
            .Cells(PasteRow, 1) = JobsArray(Counter, 6)
        End If
        
    Next Counter
    
End With

However the stage with merging the duplicate cells into one and centering the date, plus subsequent formatting is still outstanding.

Any tips?