Excel > Macro for Defined Range Dates [Solved/Closed]

Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 16, 2014 at 11:19 AM - Latest reply: Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen
- Sep 23, 2014 at 11:54 AM
Hello,

I've a question that I have starting date in Column "E3" Sheet 1 and ending date in Column "F3" Sheet 1. I want a macro that insert dates in sheet 2 from starting date and ending date mentioned in sheet1.

For Example:
Sheet1
Starting Date = 18-May-2014 (Cell E3)
Ending Date = 18-Jun-2014 (Cell F3)

Result:
Sheet2
Print Start Date to Cell B4, Second Date to Cell B5, Third Date to Cell B6 to downwards and the format of date printing should be "dd-mmm-yyy"

In Column C4 to downwards I need the "ddd" format of B4 till end but if Saturday and Sunday comes it merge the cell C4:K4 with highlighted colour.

Further whenever macro runs it clear the previous dates from sheet2 Cell B4 to downwards and then paste new.

Looking forward to your usual cooperation.

Regards,
Game Start Now
See more 

13 replies

TrowaD 2391 Posts Sunday September 12, 2010Registration dateModeratorStatus July 12, 2018 Last seen - Sep 16, 2014 at 12:03 PM
0
Thank you
Hi GSN,

See if the code below fulfils your described desires:
Sub RunMe()
Dim sDate, eDate As Date
Dim x, lRow As Long

Sheets("Sheet2").Select
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C4:K" & lRow).UnMerge
Range("C4:K" & lRow).Interior.TintAndShade = 0
Range("C4:K" & lRow).Interior.Pattern = xlNone
Range("B4:C" & lRow).ClearContents

sDate = Sheets("Sheet1").Range("E3")
eDate = Sheets("Sheet1").Range("E4")

Range("B4") = sDate
Range("C4") = WeekdayName(Weekday(sDate), , vbSunday)
x = 5

Do
    Cells(x, "B") = Cells(x - 1, "B") + 1
    Cells(x, "C") = WeekdayName(Weekday(Cells(x, "B")), , vbSunday)
    x = x + 1
Loop Until Cells(x - 1, "B") = eDate

For Each cell In Range("C4:C" & x - 1)
    If cell = "zaterdag" Or cell = "zondag" Then
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Merge
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Interior.Pattern = xlSolid
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Interior.TintAndShade = -0.149998474074526
    End If
Next cell

End Sub


Best regards,
Trowa
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 16, 2014 at 12:13 PM
0
Thank you
Date pasting formula never ends...... It exceed the end date and continues paste the date until row ends. Further Merging cell is also not working because Macro can't reach to Merge formula.
TrowaD 2391 Posts Sunday September 12, 2010Registration dateModeratorStatus July 12, 2018 Last seen - Sep 18, 2014 at 10:42 AM
Hi GSN,

Then I do need to look at your sheet setup.

I tested the code on empty sheets with date's entered in E3 and E4 ....... (.... light bulb over head switches on ....).

... and that should have been E3 and F3. I also noticed I forgot to translate the weekday names.

So forget the first sentence and try this altered code:
Sub RunMe()
Dim sDate, eDate As Date
Dim x, lRow As Long

Sheets("Sheet2").Select
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C4:K" & lRow).UnMerge
Range("C4:K" & lRow).Interior.TintAndShade = 0
Range("C4:K" & lRow).Interior.Pattern = xlNone
Range("B4:C" & lRow).ClearContents

sDate = Sheets("Sheet1").Range("E3")
eDate = Sheets("Sheet1").Range("F3")

Range("B4") = sDate
Range("C4") = WeekdayName(Weekday(sDate), , vbSunday)
x = 5

Do
    Cells(x, "B") = Cells(x - 1, "B") + 1
    Cells(x, "C") = WeekdayName(Weekday(Cells(x, "B")), , vbSunday)
    x = x + 1
Loop Until Cells(x - 1, "B") = eDate

For Each cell In Range("C4:C" & x - 1)
    If cell = "Saturday" Or cell = "Sunday" Then
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Merge
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Interior.Pattern = xlSolid
        Range(Cells(cell.Row, "C"), Cells(cell.Row, "K")).Interior.TintAndShade = -0.149998474074526
    End If
Next cell

End Sub


Sorry for the inconvenience; I was working against the clock to provide a code for you. I hope you can forgive me.

Best regards,
Trowa
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 18, 2014 at 10:47 AM
0
Thank you
Thank you it works fine except merging holiday

It also remove the heading from B3 and C3
TrowaD 2391 Posts Sunday September 12, 2010Registration dateModeratorStatus July 12, 2018 Last seen - Sep 18, 2014 at 11:32 AM
Once there is data in B4 and C4 (after running the code once), the headers will be left alone.

What do you mean by merging holiday? Is that the merging of the Saturday (crap, the auto correct showed me it's SatUrday instead of SatErday) and Sunday rows or do you mean actual specified holidays?

But I'm guessing it's the typo (change saterday into saturday in code line 26), right?

PS. I edited the code to say saturday.
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 18, 2014 at 11:39 AM
0
Thank you
I want only saturday and sunday to merge cell from Column C to Column K with highlighted

i.e. if saturday comes to row number 14 than it merge the saturday cell from C to K with highlighted

Thanks :)
TrowaD 2391 Posts Sunday September 12, 2010Registration dateModeratorStatus July 12, 2018 Last seen - Sep 23, 2014 at 11:24 AM
How are the weekday names in column C called? Is it written full out like "saturday" or short like "sat" or with caption "Saturday"?

This must match the reference in the code for it to work.
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 23, 2014 at 11:39 AM
It print weekday names as "Saturday"
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 23, 2014 at 11:44 AM
For I = 4 To LR
With Range("C" & I & ":K" & i)
If Cells(i, "C") = "Saturday" Then
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15
ElseIf Cells(i, "C") = "Sunday" Then
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15
End If
End With
Next i

This works fine for me.........
TrowaD 2391 Posts Sunday September 12, 2010Registration dateModeratorStatus July 12, 2018 Last seen - Sep 23, 2014 at 11:52 AM
That's good or you can change the caption in code line 26 as "saturday" is not identical as "Saturday".

Let me adjust the code so it shows capitols.
Game Start Now 135 Posts Thursday January 21, 2010Registration date January 7, 2017 Last seen - Sep 23, 2014 at 11:54 AM
Thanks :)