Excel > Macro for Defined Range Dates

Solved/Closed
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 - Sep 16, 2014 at 11:19 AM
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 - 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
Related:

4 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Sep 16, 2014 at 12:03 PM
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
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
Sep 16, 2014 at 12:13 PM
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.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
Sep 18, 2014 at 10:47 AM
Thank you it works fine except merging holiday

It also remove the heading from B3 and C3
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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.
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
Sep 18, 2014 at 11:39 AM
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 :)
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Sep 22, 2014 at 10:56 AM
So it's solved now, right?
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
Sep 23, 2014 at 11:15 AM
Nope....... Merging Formula is not working.........
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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.
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
Sep 23, 2014 at 11:39 AM
It print weekday names as "Saturday"
0
Game Start Now Posts 138 Registration date Thursday January 21, 2010 Status Member Last seen May 8, 2019 7
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.........
0