Solved

Excel week commencing formula

Posted on 2008-10-21
6
1,567 Views
Last Modified: 2011-10-19
Is there a formula that when a name is entered into cell A2 the week commencing date automates in to cell B2? (Week commencing from a monday)
0
Comment
Question by:Carlandrewlewis
  • 4
  • 2
6 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22765650
Something like the following snippet?

Chris
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

Dim cel As Range
 

    Set rng = Intersect(Target, Me.Range("a:A"))

    If rng Is Nothing Then Exit Sub

    

    For Each cel In rng

        If cel <> "" Then cel.Offset(0, 1) = DateAdd("d", -(Weekday(Date, vbTuesday)), Date)

    Next

    

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22765653
To Create a macro:
------------------

Alt + F11 to open the macro editor
  For workbook event handlers:
     In the project tree select as appropriate:
      EXCEL      : thisworkbook
     In the workpane select as appropriate:
      EXCEL      : WorkBook
     In the workpane select the required 'event', (i.e. 'Change').
     Insert the required macro(s) into the selected subroutine.
Close the Visual Basic Editor.

Check Security as appropriate:
------------------------------

In the application select Tools | Macro | Security
Select Medium
Select OK

Chris
0
 

Author Comment

by:Carlandrewlewis
ID: 22765733
Is there a way to add this into this file. Basically when a date is entered into column A of 'New Seet' it should then automatically fill out column B with the week commencing that will then fill out column C with the week number. I'm just having trouble inserting the code in the right place....
Weekly-Pay-Schedule-1.xls
0
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 22765831
I have posted a change to your change event handler as follows in teh snippet below:

rCell.Offset(0, 1) = DateAdd("d", -(Weekday(rCell, vbTuesday)), rCell)

Chris
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

On Error GoTo e:

If Intersect(Target, Columns("A")) Is Nothing Then Exit Sub

Dim ws As Worksheet

Set ws = ActiveSheet

Dim rCell As Range

Set rCell = Intersect(Target, Columns("A"))

If rCell.Value = "" Then Exit Sub

rCell.Offset(0, 1) = DateAdd("d", -(Weekday(rCell, vbTuesday)), rCell)

Sheets("Template").Select

Sheets("Template").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = rCell

ActiveSheet.Range("i3").Value = rCell

On Error GoTo e:

Application.ScreenUpdating = True

Exit Sub

e:

Application.ScreenUpdating = True

End Sub

Open in new window

0
 

Author Closing Comment

by:Carlandrewlewis
ID: 31508189
Works perfectly, thanks chris!!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22766160
You're welcome and thanks for the grade.

Chris
0

Featured Post

Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A high-level exploration of how our ever-increasing access to information has changed the way we do our jobs.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now