Rabu, 28 September 2011

Re: [ExcelVBA] Macro to run until dates match

Ok, here they are, the first macro is called from a button on the cover
sheet, this then runs the other macro, which I'm sure will be obvious to
you. As I said before, C1 contains the week ending date, D1 contains a
simple formula; =C1+7, and this is copied and pasted with values into C1,
thus increasing the week by one, the rest of the macro simple copies and
inserts cut cells on the various worksheets in the workbook. The date update
therefore is a purely passive action. What I would like to be able to do is
to type a week ending date into a given cell, and run a macro that would run
the already written macros until c1 is equal to the date that has been
input.

Thanks again

Tony

Macro run from Cover sheet:****

** **

Sub Macro28()****

'****

' Macro28 Macro****

'****

** **

'****

Sheets("HAW").Select****

Application.Run "'New WCG Roster.xlsm'!HAW_Forward_Macro"****

Sheets("KNT").Select****

Application.Run "'New WCG Roster.xlsm'!KNT_Forward_Macro"****

Sheets("SKT").Select****

Application.Run "'New WCG Roster.xlsm'!SKT_Forward_Macro"****

Sheets("NWM").Select****

Application.Run "'New WCG Roster.xlsm'!NMW_Forward_Macro"****

Sheets("WEM").Select****

Application.Run "'New WCG Roster.xlsm'!WEM_Forward_Macro"****

Sheets("SPK").Select****

Application.Run "'New WCG Roster.xlsm'!SPK_Forward_Macro"****

Sheets("HAR").Select****

Application.Run "'New WCG Roster.xlsm'!HAR_Forward_Macro"****

Sheets("KGN").Select****

Application.Run "'New WCG Roster.xlsm'!KGN_Forward_Macro"****

Sheets("QPK").Select****

Application.Run "'New WCG Roster.xlsm'!QPK_Forward_Macro"****

Sheets("Cover").Select****

End Sub****

Sub Group_Roster_Reverse()****

'****

' Group_Roster_Reverse Macro****

'****

** **

'****

Sheets("HAW").Select****

Application.Run "'New WCG Roster.xlsm'!HAW_Reverse_Macro"****

Sheets("KNT").Select****

Application.Run "'New WCG Roster.xlsm'!KNT_Reverse_Macro"****

Sheets("SKT").Select****

Application.Run "'New WCG Roster.xlsm'!SKT_Reverse_Macro"****

Sheets("NWM").Select****

Application.Run "'New WCG Roster.xlsm'!NWM_Reverse_Macro"****

Sheets("WEM").Select****

Application.Run "'New WCG Roster.xlsm'!WEM_Reverse_Macro"****

Sheets("SPK").Select****

Application.Run "'New WCG Roster.xlsm'!SPK_Reverse_Macro"****

Sheets("HAR").Select****

Application.Run "'New WCG Roster.xlsm'!HAR_Reverse_Macro"****

Sheets("KGN").Select****

Application.Run "'New WCG Roster.xlsm'!KGN_Reverse_Macro"****

Sheets("QPK").Select****

Application.Run "'New WCG Roster.xlsm'!QPK_Reverse_Macro"****

Sheets("Cover").Select****

End Sub****

** **

Sub HAW_Forward_Macro()****

'****

' HAW_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B8").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B5").Select****

Selection.Insert Shift:=xlDown****

Range("B24").Select****

Selection.Cut****

Range("B13").Select****

Selection.Insert Shift:=xlDown****

Range("B35").Select****

Selection.Cut****

Range("B29").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub HAW_Reverse_Macro()****

'****

' HAW_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B5").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B9").Select****

Selection.Insert Shift:=xlDown****

Range("B13").Select****

Selection.Cut****

Range("B25").Select****

Selection.Insert Shift:=xlDown****

Range("B29").Select****

Selection.Cut****

Range("B36").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub KNT_Forward_Macro()****

'****

' KNT_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Application.CutCopyMode = False****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B5").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B7").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub KNT_Reverse_Macro()****

'****

' KNT_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B6").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B5").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub SKT_Forward_Macro()****

'****

' SKT_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B6").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B8").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub SKT_Reverse_Macro()****

'****

' SKT_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B7").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B6").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub NMW_Forward_Macro()****

'****

' NMW_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B6").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B8").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub NWM_Reverse_Macro()****

'****

' NWM_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B7").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B6").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub WEM_Forward_Macro()****

'****

' WEM_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B9").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B5").Select****

Selection.Insert Shift:=xlDown****

Range("B17").Select****

Selection.Cut****

Range("B14").Select****

Selection.Insert Shift:=xlDown****

Range("B28").Select****

Selection.Cut****

Range("B22").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub WEM_Reverse_Macro()****

'****

' WEM_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B5").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B10").Select****

Selection.Insert Shift:=xlDown****

Range("B14").Select****

Selection.Cut****

Range("B18").Select****

Selection.Insert Shift:=xlDown****

Range("B22").Select****

Selection.Cut****

Range("B29").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub SPK_Forward_Macro()****

'****

' SPK_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B8").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B5").Select****

Selection.Insert Shift:=xlDown****

Range("B16").Select****

Selection.Cut****

Range("B13").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub SPK_Reverse_Macro()****

'****

' SPK_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B5").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B9").Select****

Selection.Insert Shift:=xlDown****

Range("B13").Select****

Selection.Cut****

Range("B17").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub HAR_Forward_Macro()****

'****

' HAR_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B7").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B6").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub HAR_Reverse_Macro()****

'****

' HAR_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B6").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B8").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub KGN_Forward_Macro()****

'****

' KGN_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B8").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B6").Select****

Selection.Insert Shift:=xlDown****

Range("B15").Select****

Selection.Cut****

Range("B13").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub KGN_Reverse_Macro()****

'****

' KGN_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B6").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B9").Select****

Selection.Insert Shift:=xlDown****

Range("B13").Select****

Selection.Cut****

Range("B16").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub QPK_Forward_Macro()****

'****

' QPK_Forward_Macro Macro****

'****

** **

'****

Range("D1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B9").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B5").Select****

Selection.Insert Shift:=xlDown****

Range("B18").Select****

Selection.Cut****

Range("B14").Select****

Selection.Insert Shift:=xlDown****

Range("B28").Select****

Selection.Cut****

Range("B23").Select****

Selection.Insert Shift:=xlDown****

End Sub****

Sub QPK_Reverse_Macro()****

'****

' QPK_Reverse_Macro Macro****

'****

** **

'****

Range("E1").Select****

Selection.Copy****

Range("C1").Select****

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _****

:=False, Transpose:=False****

Range("B5").Select****

Application.CutCopyMode = False****

Selection.Cut****

Range("B10").Select****

Selection.Insert Shift:=xlDown****

Range("B14").Select****

Selection.Cut****

Range("B19").Select****

Selection.Insert Shift:=xlDown****

Range("B23").Select****

Selection.Cut****

Range("B29").Select****

Selection.Insert Shift:=xlDown****

End Sub


On 28 September 2011 18:26, Paul Schreiner <schreiner_paul@att.net> wrote:

> **
>
>
> I spend so much of my time looking at the emails DISTRIBUTED, that I don't
>
> usually go to the site itself.
>
> If the macro is LARGE, then it might be easier to summarize it.
> ("large" is a relative term... to me, 500 lines isn't large.)
>
> I'd start with posting the macro, and perhaps some sample data.
>
> If it's too cumbersome to work with, one of us may ask for you to send a
> file
> directly.
>
>
> Paul
> -----------------------------------------
> "Do all the good you can,
> By all the means you can,
> In all the ways you can,
> In all the places you can,
> At all the times you can,
> To all the people you can,
> As long as ever you can." - John Wesley
> -----------------------------------------
>
> ________________________________
> From: Tony Davis <studiot@gmail.com>
> To: ExcelVBA@yahoogroups.com
> Sent: Wed, September 28, 2011 5:33:12 AM
> Subject: Re: [ExcelVBA] Macro to run until dates match
>
>
> Hi Paul,
>
> What is the protocol here, should I copy/paste the macro to an email,as I
> see that attachments are frowned upon?
>
> Tony
>
> On 27 September 2011 13:16, Paul Schreiner <schreiner_paul@att.net> wrote:
>
> > **
> >
> >
> > I'm not sure if the terms you're using match the definitions that I have
> > for the
> > same terms!
> >
> > If you're running an actual macro, then you can always create a loop
> > (while, or
> > for..)
> > and test a value against the value in a cell.
> >
> > If you can show us what your macro looks like, perhaps we can suggest
> > changes to
> > create the loop.
> >
> > Paul
> > -----------------------------------------
> > "Do all the good you can,
> > By all the means you can,
> > In all the ways you can,
> > In all the places you can,
> > At all the times you can,
> > To all the people you can,
> > As long as ever you can." - John Wesley
> > -----------------------------------------
> >
> > ________________________________
> > From: Tony <studiot@gmail.com>
> > To: ExcelVBA@yahoogroups.com
> > Sent: Tue, September 27, 2011 6:36:59 AM
> > Subject: [ExcelVBA] Macro to run until dates match
> >
> >
> >
> > Not sure if what I am asking is possible, but I have a workbook with
> macros
> > that
> > rotate staff against duties and advance the week ending date. ( simply
> > done; C1
> > contains weekending date, D1=C1+7, so I copy and paste special values,
> the
> > staff
> > are rotated by cut and insert cut cells)
> >
> > with this I run the macro which will advance 1 week at a time, until I
> > reach the
> > desired week ending date. What I was wondering was if it would be
> possible
> > to
> > write a macro that would advance until a date entered in another cell was
> > matched? E.G. I enter 25/12/11 in a designated cell and execute the macro
> > which
> > will run until C1 contains the same date.
> >
> > Regards
> >
> > Tony
> >
> > [Non-text portions of this message have been removed]
> >
> >
> >
>
> --
> Save paper - do you really need to print this email?
> Save electricity - do you really need to send this email?
> Save your own energy - do you really need to read this email?
>
> [Non-text portions of this message have been removed]
>
> ------------------------------------
>
>
> ----------------------------------
> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go
> here:
> http://www.mousetrax.com/techtrax to enter the ezine, then search the
> ARCHIVES
> for EXCEL VBA.
>
> ----------------------------------
> Visit our ExcelVBA group home page for more info and support files:
> http://groups.yahoo.com/group/ExcelVBA
>
> ----------------------------------
> More free tutorials and resources available at:
> http://www.mousetrax.com
>
> ----------------------------------Yahoo! Groups Links
>
>
> [Non-text portions of this message have been removed]
>
>
>

--
Save paper - do you really need to print this email?
Save electricity - do you really need to send this email?
Save your own energy - do you really need to read this email?


[Non-text portions of this message have been removed]

------------------------------------

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------Yahoo! Groups Links

<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/ExcelVBA/

<*> Your email settings:
Individual Email | Traditional

<*> To change settings online go to:
http://groups.yahoo.com/group/ExcelVBA/join
(Yahoo! ID required)

<*> To change settings via email:
ExcelVBA-digest@yahoogroups.com
ExcelVBA-fullfeatured@yahoogroups.com

<*> To unsubscribe from this group, send an email to:
ExcelVBA-unsubscribe@yahoogroups.com

<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/

Tidak ada komentar:

Posting Komentar