[ExcelVBA] Re: Macro to run until dates match

 

bu&&er, I missed some dots out in that last post, try this, which hopefully will have fewer line-wrap problems:

Sub fromCoverSheet()
Forward Sheets("HAW"), Array("B8", "B5", "B24", "B13", _
"B35", "B29")
Forward Sheets("KNT"), Array("B5", "B7")
Forward Sheets("SKT"), Array("B6", "B8")
Forward Sheets("NWM"), Array("B6", "B8")
Forward Sheets("WEM"), Array("B9", "B5", "B17", "B14", _
"B28", "B22")
Forward Sheets("SPK"), Array("B8", "B5", "B16", "B13")
Forward Sheets("HAR"), Array("B7", "B6")
Forward Sheets("KGN"), Array("B8", "B6", "B15", "B13")
Forward Sheets("QPK"), Array("B9", "B5", "B18", "B14", _
"B28", "B23")
End Sub

Sub Group_Roster_Reverse2()
Reverse Sheets("HAW"), Array("B5", "B9", "B13", "B25", _
"B29", "B36")
Reverse Sheets("KNT"), Array("B6", "B5")
Reverse Sheets("SKT"), Array("B7", "B6")
Reverse Sheets("NWM"), Array("B7", "B6")
Reverse Sheets("WEM"), Array("B5", "B10", "B14", "B18", _
"B22", "B29")
Reverse Sheets("SPK"), Array("B5", "B9", "B13", "B17")
Reverse Sheets("HAR"), Array("B6", "B8")
Reverse Sheets("KGN"), Array("B6", "B9", "B13", "B16")
Reverse Sheets("QPK"), Array("B5", "B10", "B14", "B19", _
"B23", "B29")
End Sub

Sub Forward(TheSheet, PairedCellsArray)
Debug.Assert _
Application.IsOdd(UBound(PairedCellsArray) - _
LBound(PairedCellsArray))
With TheSheet
.Range("C1").Value = .Range("D1").Value
For i = LBound(PairedCellsArray) To _
UBound(PairedCellsArray) Step 2
Debug.Print PairedCellsArray(i), _
PairedCellsArray(i + 1)
.Range(PairedCellsArray(i)).Cut: _
.Range(PairedCellsArray(i + 1)).Insert _
Shift:=xlDown
Next i
End With
End Sub

Sub Reverse(TheSheet, PairedCellsArray)
Debug.Assert _
Application.IsOdd(UBound(PairedCellsArray) - _
LBound(PairedCellsArray))
With TheSheet
.Range("C1").Value = .Range("E1").Value
For i = LBound(PairedCellsArray) To _
UBound(PairedCellsArray) Step 2
Debug.Print PairedCellsArray(i), _
PairedCellsArray(i + 1)
.Range(PairedCellsArray(i)).Cut: _
.Range(PairedCellsArray(i + 1)).Insert _
Shift:=xlDown
Next i
End With
End Sub

--- In ExcelVBA@yahoogroups.com, "Pascal" <pascaldaulton@...> wrote:
>
> The below macros are ALL your code condensed (untested, but could you test it for me?), now all I need is the answer to the 'Next question' of my last message.
>
> These will probably be garbled by Yahoo's line-wrapping:
>
> Sub fromCoverSheet()
> Forward Sheets("HAW"), Array("B8", "B5", "B24", "B13", "B35", "B29")
> Forward Sheets("KNT"), Array("B5", "B7")
> Forward Sheets("SKT"), Array("B6", "B8")
> Forward Sheets("NWM"), Array("B6", "B8")
> Forward Sheets("WEM"), Array("B9", "B5", "B17", "B14", "B28", "B22")
> Forward Sheets("SPK"), Array("B8", "B5", "B16", "B13")
> Forward Sheets("HAR"), Array("B7", "B6")
> Forward Sheets("KGN"), Array("B8", "B6", "B15", "B13")
> Forward Sheets("QPK"), Array("B9", "B5", "B18", "B14", "B28", "B23")
> End Sub
>
> Sub Group_Roster_Reverse2()
> Reverse Sheets("HAW"), Array("B5", "B9", "B13", "B25", "B29", "B36")
> Reverse Sheets("KNT"), Array("B6", "B5")
> Reverse Sheets("SKT"), Array("B7", "B6")
> Reverse Sheets("NWM"), Array("B7", "B6")
> Reverse Sheets("WEM"), Array("B5", "B10", "B14", "B18", "B22", "B29")
> Reverse Sheets("SPK"), Array("B5", "B9", "B13", "B17")
> Reverse Sheets("HAR"), Array("B6", "B8")
> Reverse Sheets("KGN"), Array("B6", "B9", "B13", "B16")
> Reverse Sheets("QPK"), Array("B5", "B10", "B14", "B19", "B23", "B29")
> End Sub
>
> Sub Forward(TheSheet, PairedCellsArray)
> Debug.Assert Application.IsOdd(UBound(PairedCellsArray) - LBound(PairedCellsArray))
> With TheSheet
> .Range("C1").Value = .Range("D1").Value
> For i = LBound(PairedCellsArray) To UBound(PairedCellsArray) Step 2
> Debug.Print PairedCellsArray(i), PairedCellsArray(i + 1)
> Range(PairedCellsArray(i)).Cut: Range(PairedCellsArray(i + 1)).Insert Shift:=xlDown
> Next i
> End With
> End Sub
>
> Sub Reverse(TheSheet, PairedCellsArray)
> Debug.Assert Application.IsOdd(UBound(PairedCellsArray) - LBound(PairedCellsArray))
> With TheSheet
> .Range("C1").Value = .Range("E1").Value
> For i = LBound(PairedCellsArray) To UBound(PairedCellsArray) Step 2
> Debug.Print PairedCellsArray(i), PairedCellsArray(i + 1)
> Range(PairedCellsArray(i)).Cut: Range(PairedCellsArray(i + 1)).Insert Shift:=xlDown
> Next i
> End With
> End Sub
>
>
> --- In ExcelVBA@yahoogroups.com, "Pascal" <pascaldaulton@> wrote:
> >
> > Yes, there's quite a lot of repeating code, so first I want to condense your code a bit, by having one macro do the repeating stuff and passing to it which cells have to be moved/copied around.
> > I notice that all the Forward macros have the same start copying D1 to C1, also all the reverse macros copy E1 to C1. Then the rest is sheet specific. So I summarised each macro, the first pair of cells copy, subsequent pairs cut and insert. You might confirm that I've got it right:
> > Sub HAW_Forward_Macro("C1","D1","B8","B5","B24","B13","B35","B29")
> > Sub KNT_Forward_Macro("C1","D1","B5","B7")
> > Sub SKT_Forward_Macro("C1","D1","B6","B8")
> > Sub NMW_Forward_Macro("C1","D1","B6","B8")
> > Sub WEM_Forward_Macro("C1","D1","B9","B5","B17","B14","B28","B22")
> > Sub SPK_Forward_Macro("C1","D1","B8","B5","B16","B13")
> > Sub HAR_Forward_Macro("C1","D1","B7","B6")
> > Sub KGN_Forward_Macro("C1","D1","B8","B6","B15","B13")
> > Sub QPK_Forward_Macro("C1","D1","B9","B5","B18","B14","B28","B23")
> > Sub HAW_Reverse_Macro("C1","E1","B5","B9","B13","B25","B29","B36")
> > Sub KNT_Reverse_Macro("C1","E1","B6","B5")
> > Sub SKT_Reverse_Macro("C1","E1","B7","B6")
> > Sub NWM_Reverse_Macro("C1","E1","B7","B6")
> > Sub WEM_Reverse_Macro("C1","E1","B5","B10","B14","B18","B22","B29")
> > Sub QPK_Reverse_Macro("C1","E1","B5","B10","B14","B19","B23","B29")
> > Sub SPK_Reverse_Macro("C1","E1","B5","B9","B13","B17")
> > Sub HAR_Reverse_Macro("C1","E1","B6","B8")
> > Sub KGN_Reverse_Macro("C1","E1","B6","B9","B13","B16")
> >
> > Next question: You mention repeating until C1 reaches a certain date, and I also presume that the the cell C1 on all the sheets contain the same date - that is they never get out of kilter? If they were to get out of kilter, would you like the macro to bring them all back into line?
> >
> > I don't think this should be too difficult to do.
> >
> > --- In ExcelVBA@yahoogroups.com, Tony Davis <studiot@> wrote:
> > >
> > > Hi all,
> > >
> > > I just wondered if there was any luck with the following, as I never had any
> > > posts back.
> > >
> > > kind regards
> > >
> > > Tony
>

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (15)

Recent Activity:

• New Members 2

Visit Your Group

----------------------------------
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

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

MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___