Previous Topic Next Topic

Excel > Macro for Defined Range Dates

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

Réponse 1 / 4
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
16 Sep 2014 à 12:03
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
Réponse 2 / 4
Game Start Now Posts 138 Registration date Thursday 21 January 2010 Status Member Last seen 8 May 2019 7
16 Sep 2014 à 12:13
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 Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
18 Sep 2014 à 10:42
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
Réponse 3 / 4
Game Start Now Posts 138 Registration date Thursday 21 January 2010 Status Member Last seen 8 May 2019 7
18 Sep 2014 à 10:47
Thank you it works fine except merging holiday

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