using weeknum to correct dates into a different worksheet.

[Godders199]

Hello, I need some help, I have a workbook, with Sheet A andSheet B . Sheet A is a summary andSheet B does all the calculations based on a date range given in cells A1 andB1 if that sheet.

I am trying to find an example of code for the following whichgoes down to week 52

11/12/2018​	​	​	​	​	​
Year	2018​	​	​	​	​
current week number	50​	​	​	​	Total​
Week Number	1​	01/01/2018​	07/01/2018​	​	​
	2​	08/01/2018​	14/01/2018​	​	​
	3​	15/01/2018​	21/01/2018​	​	​
	4​	22/01/2018​	28/01/2018​	​	​

<tbody> </tbody>

Current week number is b11
Effectively I need the code to basically start at week 1 andgo down until the week number equals the current week, insert the relevantdates in columns c and d into A1 and B1 on Sheet B. pause while it performs is calculations theninsert the value from A50 in therelevant row in Sheet A column F.
To be honest its mainly getting the correct dates inserted Ineed help on. So if anyone has an example or a link I would be grateful.

 

[Godders199]

I am making progress slowly, the following code identifies the correct row and will copy the start date, how do i select the second date

Dim SrchRng As Range, cel As Range
Set SrchRng = Range("b12:b63")
For Each cel In SrchRng
If cel.Value = Range("b11") Then
cel.Offset(0, 1).Copy
Sheets("sheet2").Range("a1").PasteSpecial

 

[Perpa]

Godders199,


The following is a formula solution.

The WEEKNUM function works on the calendar week. That is to say, the first day of each month may not be on Sunday, so there would be a few days in the previous month included in Week1.
For example, for December 2018, the beginning of Week1 is Sunday, 25-Nov-2018, and the end of Week1 is Saturday, 1-Dec-2018. I labled columns C and D 'Sunday' and 'Saturday' respectively for clarity.

Here are the the formulae used:

B4  =WEEKNUM(A1)
C8   =IF(MONTH(A1)<>1,DATEVALUE(MONTH(A1)-1&"/"&DAY(EOMONTH(A1,-1))-WEEKDAY(DATE(YEAR(A1),MONTH(A1),1))+2&"/"&YEAR(A1)),DATEVALUE(12&"/"&DAY(EOMONTH(A1,-1))-WEEKDAY(DATE(YEAR(A1-1),MONTH(A1-1),1))+2&"/"&YEAR(A1)-1))
D8  =DATE(YEAR(A1),MONTH(A1),1)+7-WEEKDAY(DATE(YEAR(A1),MONTH(A1),1))
C10 =IF($B10<=$B$4,$D8+1,"")
D10  =IF($B10<=$B$4,$D8+7,"")


The cells below are just copied and pasted from the formulae in C10 and D10 and will look similar to this:
C12  =IF($B12<=$B$4,$D10+1,"")
D12  =IF($B12<=$B$4,$D10+7,"")
etc... down 52 weeks and beyond if necessary

It wasn't clear where your data was located, so you may have to tweak the formulae in C10 and D10 before you copy them down to the 52 week row.
You can see from the image I have included that I put a blank row between each week to make it more legible. You can change that if necessary. I also formatted the dates in a form that is less confusing for me.
I hope this is helpful.
Perpa

 

[majidsiddique]

Hi Perpa:
i use this formula of C8 but dint work properly and error.
Thanks.

 

[Perpa]

Hi Perpa:
i use this formula of C8 but dint work properly and error.
Thanks.

Hello majidsiddique,
Check your cell references and date formatting. As you can see from the image I posted it did work for me with those date formats.
You might also try breaking the formula down into smaller pieces to see where it is not working for you and let us know what is not working.


C8 =IF(MONTH(A1)<>1,DATEVALUE(MONTH(A1)-1&"/"&DAY(EOMONTH(A1,-1))-WEEKDAY(DATE(YEAR(A1),MONTH(A1),1))+2&"/"&YEAR(A1)),DATEVALUE(12&"/"&DAY(EOMONTH(A1,-1))-WEEKDAY(DATE(YEAR(A1-1),MONTH(A1-1),1))+2&"/"&YEAR(A1)-1))


With the first part:
=DATEVALUE(MONTH(A1)-1&"/"&DAY(EOMONTH(A1,-1))-WEEKDAY(DATE(YEAR(A1),MONTH(A1),1))+2&"/"&YEAR(A1))
What do you get for each part:

=MONTH(A1)-1
=DAY(EOMONTH(A1,-1))
=WEEKDAY(DATE(YEAR(A1),MONTH(A1),1))+2
=DATE(YEAR(A1),MONTH(A1),1)

Perpa

 

[Godders199]

So I have it to function as I need, but it loops through to52, no matter what week number I chose, everything updates correctly, How to I changethe code to stop when it has updated the relevant week?
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim SrchRng As Range, cel As Range
Set SrchRng =Worksheets("requirements").Range("b12:b63")
For Each cel In SrchRng
Sheets("info").Select
Range("A6").Value = ActiveWorkbook.Name
Qfile =Range("A6").Value
Afile =Range("a3").Value
Workbooks.Open "xxx.xlsm"
Windows(Qfile).Activate
Sheets("requirements").Select
If cel.Value =Range("b11") Then
cel.Offset(0,1).Copy
Windows("xxx.xlsm").Activate
Range("a1").PasteSpecial Paste:=xlPasteValues
Windows(Qfile).Activate
cel.Offset(0,2).Copy
Windows("xxx.xlsm").Activate
Range("b1").PasteSpecial Paste:=xlPasteValues
Range("b71:c71").Copy
Windows(Qfile).Activate
cel.Offset(0,4).PasteSpecial Paste:=xlPasteValues
Range("a1").Select
End If
Next cel
Windows("xxx.xlsm").Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True

 

[Perpa]

Godders199,
If I understand correctly, adding the two lines in red should do the trick.
Good luck!
Perpa

[FONT=Calibri][SIZE=3][COLOR=#000000]    Range("a1").Select
[/COLOR][/SIZE][/FONT]   [COLOR=#ff0000]Goto FinalWeek[/COLOR]
[FONT=Calibri][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Next cel

[/COLOR][/SIZE][/FONT][COLOR=#ff0000]FinalWeek:[/COLOR]
[FONT=Calibri][SIZE=3][COLOR=#000000]Windows("xxx.xlsm").Close[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.DisplayAlerts = True[/COLOR][/SIZE][/FONT]

 

[majidsiddique]

Hi Perpa,
Thank for your guidance ,
Its working
Thanks

 

[Perpa]

majidsiddique,
Glad I could help...You are welcome.
Perpa

 

[Godders199]

thanks for your help