How to count the number of wednesdays in the next month given the date of the last wednesday of the previous month

[aletheasim96]

Hello everyone! Okay im super new to excel vba so I apologise if my question is really basic:P I've been asked to automate the sheet below but have no idea how to go about it. So the data values in the table are linked to a PHD system that generates the data using the dates at the top of each column. So what i am supposed to do is to come up with a button that can generate the dates of the next 4 or 5 wednesdays in the next month, depending on exactly how many wednesdays fall in the next month, given the date of the last wednessday of the previous month, in this case 28 Feb. So the desired end result of running the code would be to add the next 4 or 5 wednesdays to the columns next to the last entry(28 Feb in this case) and to drag the formulas from the previous data columns to generate the results for these new columns. Could anyone give me advice on how to do this? Any help is much appreciated!!!



[TABLE="width: 500"]
<tbody>[TR]
[TD]03-Jan-2018 8:48:00PM[/TD]
[TD]10-Jan-2018 8:48:00PM[/TD]
[TD]17-Jan-2018 8:48:00PM[/TD]
[TD]24-Jan-2018 8:48:00PM[/TD]
[TD]31-Jan-2018 8:48:00PM[/TD]
[TD]07-Feb-2018 8:48:00PM[/TD]
[TD]14-Feb-2018 8:48:00PM[/TD]
[TD]21-Feb-2018 8:48:00PM[/TD]
[TD]28-Feb-2018 8:48:00PM[/TD]
[/TR]
[TR]
[TD]2654[/TD]
[TD]254[/TD]
[TD]254[/TD]
[TD]24[/TD]
[TD]52[/TD]
[TD]687[/TD]
[TD]76[/TD]
[TD]67[/TD]
[TD]67[/TD]
[/TR]
[TR]
[TD]423[/TD]
[TD]45[/TD]
[TD]3454[/TD]
[TD]2452[/TD]
[TD]52[/TD]
[TD]5[/TD]
[TD]25[/TD]
[TD]86[/TD]
[TD]78[/TD]
[/TR]
[TR]
[TD]245[/TD]
[TD]2452[/TD]
[TD]54[/TD]
[TD]42[/TD]
[TD]4[/TD]
[TD]42[/TD]
[TD]87[/TD]
[TD]52[/TD]
[TD]76
[/TD]
[/TR]
[TR]
[TD]42[/TD]
[TD]245[/TD]
[TD]254[/TD]
[TD]4[/TD]
[TD]542252[/TD]
[TD]45[/TD]
[TD]5225[/TD]
[TD]78[/TD]
[TD]86[/TD]
[/TR]
[TR]
[TD]452[/TD]
[TD]452[/TD]
[TD]424[/TD]
[TD]25[/TD]
[TD]25[/TD]
[TD]25[/TD]
[TD]525[/TD]
[TD]89
[/TD]
[TD]785
[/TD]
[/TR]
[TR]
[TD]45[/TD]
[TD]45[/TD]
[TD]24[/TD]
[TD]4[/TD]
[TD]54[/TD]
[TD]8[/TD]
[TD]67[/TD]
[TD]67[/TD]
[TD]54[/TD]
[/TR]
</tbody>[/TABLE]


Thank you!!!!

 

[Scott T]

Try this
I assume the dates are in row 1 and they are excel dates not text. I find the last row used based on column A. Change to a column that will always have data. I assume the data starts in row 2

Sub popwed()

Dim lc As Long
Dim lr As Long
Dim lastwed As Date
Dim lmonth As Long
Dim nmonth As Long


lc = Cells(1, Columns.Count).End(xlToLeft).Column 'find last column used
lr = Cells(Rows.Count, "A").End(xlUp).Row 'find last row of date
lastwed = Cells(1, lc) 'the last date
lmonth = Month(lastwed) 'month of the last date


If lmonth = 12 Then 'set the next month
    nmonth = 1
Else
    nmonth = lmonth + 1
End If


For x = 1 To 5 'loop to populate the next 4 or 5 wed
    If Month(Cells(1, lc + x - 1) + 7) = nmonth Then
        Cells(1, lc + x) = Cells(1, lc + x - 1) + 7
    Else
        Exit For
    End If
    
Next x


'copy formulas
nlc = Cells(1, Columns.Count).End(xlToLeft).Column 'find new last column used
Range(Cells(2, lc), Cells(lr, lc)).Copy Range(Cells(2, lc + 1), Cells(lr, nlc))


End Sub

 

[aletheasim96]

Hey Scott, I've tried it and it does exactly what i wanted it to! However, i have other data on the sheet above and below the rows im currently working on and when i run the code it works on all the rows. Is there a way to limit it to just rows 51 to 63? Sorry for not stating this in my original post and thanks so much for your time!

 

[Scott T]

This will only copy from rows 51 to 63 in the last column

Sub popwed()

Dim lc As Long
Dim lastwed As Date
Dim lmonth As Long
Dim nmonth As Long




lc = Cells(1, Columns.Count).End(xlToLeft).Column 'find last column used
lastwed = Cells(1, lc) 'the last date
lmonth = Month(lastwed) 'month of the last date


If lmonth = 12 Then 'set the next month
    nmonth = 1
Else
    nmonth = lmonth + 1
End If




For x = 1 To 5 'loop to populate the next 4 or 5 wed
    If Month(Cells(1, lc + x - 1) + 7) = nmonth Then
        Cells(1, lc + x) = Cells(1, lc + x - 1) + 7
    Else
        Exit For
    End If
    
Next x


'copy formulas
nlc = Cells(1, Columns.Count).End(xlToLeft).Column 'find new last column used
Range(Cells(51, lc), Cells(63, lc)).Copy Range(Cells(51, lc + 1), Cells(63, nlc))




End Sub

 

[aletheasim96]

Hey Scott, it works awesome Thanks so much man!!