Selecting Sheets based on a VBA array

[PaulyP]

Hi All,

I need help, it's been 15 years since I did any VBA and so I'm learning from scratch again - and not doing very well!

I am creating a workbook with sheets from April to March (Financial Year).


I am putting a macro button on each sheet to copy the current monthly data to subsequent months. i.e if I am updating figures on the July's sheet I want to then press the button and copy the July data on to the August, September, October... etc sheets.


I am ok with the button and macro and selecting and copying the data in VBA. The part I am having most trouble with, is selecting the all subsequent months from the sheet that is currently active.

In the code below:

I started with identifying the current sheet and then setting up an array containing each month.
After that there is some code for a warning box so I don't do it by accident.

Then the code for the cells to copy

Followed by the code for the sheets where I need to select all subsequent sheets - this is where I am stuck.

And then finally there is code to confirm that the operation has completed and copied the data to the remaining month - I managed to do a message listing all the remaining months - though it's probably not a very elegant way of doing it! :)



Sub Macro3()

CurrentSheet = ActiveSheet.Name

Dim SheetID(12) As String

SheetID(0) = "January"
SheetID(1) = "February"
SheetID(2) = "March"
SheetID(3) = "April"
SheetID(4) = "May"
SheetID(5) = "June"
SheetID(6) = "July"
SheetID(7) = "August"
SheetID(8) = "September"
SheetID(9) = "October"
SheetID(10) = "November"
SheetID(11) = "December"



For i = 0 To 11

If SheetID(i) = CurrentSheet Then

Dim Answer As VbMsgBoxResult
Answer = MsgBox("You are about to copy " & ActiveSheet.Name & " occupancy figures to the following month." _
& VBA.Constants.vbNewLine & "WARNING: THIS ACTION CAN NOT BE UNDONE!", vbOKCancel + vbQuestion + vbDefaultButton2, ActiveSheet.Name & " Occupancy Copy to Next Month")

If Answer = vbOK Then
Range("F4:F122").Select
Selection.Copy

Sheets(?????????).Select ' <<<<<<<<<<<<<<<<<<<<<This is where I am stuck! How to select all sheets following the current sheet.

Range("F4:F122").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(CurrentSheet).Select

Else

Exit Sub

End If

Dim Months As String
Dim RemainingMonths(11) As String

For x = i + 1 To 11
RemainingMonths(x) = SheetID(x)
Next x

Months = Join(RemainingMonths)

MsgBox "Data copied to: " & Months

End If

Next i


End Sub



This all works fine if I just enter the name for a single month where the red ????? are, so hopefully someone can help me with selecting the months I need which varies depending on the currently active sheet.

I hope that's all clear and any help would be much appreciated.

Many thanks

Paul

[rollis13]

This will select your next month's sheet:
Sheets(SheetID(i + 1)).SelectBut what will happen when you get to decembre (december + 1) ? Maybe an extra If/Then could be helpfull or shorten the For/Next.

[PaulyP]

Thanks rollis123 for the very quick reply but what I actually need to do is to be able to select ALL the subsequent sheets, not just the next one so that when the data is pasted, it gets pasted on to multiple sheets at the same time.

Good point about when getting to the end of the series - will need to adjust code for that as you suggest.

[rollis13]

Have a try, did some adjusting, hopefully I didn't add issues:
Option Explicit
Sub Macro3_new()
Dim CurrentSheet, i, x
Dim Months As String
CurrentSheet = ActiveSheet.Name
If CurrentSheet = "December" Then
MsgBox "It's useless to Copy/Paste after " & CurrentSheet
Exit Sub
End If
Dim SheetID(11) As String
SheetID(0) = "January"
SheetID(1) = "February"
SheetID(2) = "March"
SheetID(3) = "April"
SheetID(4) = "May"
SheetID(5) = "June"
SheetID(6) = "July"
SheetID(7) = "August"
SheetID(8) = "September"
SheetID(9) = "October"
SheetID(10) = "November"
SheetID(11) = "December"
For i = 0 To 10
If SheetID(i) = CurrentSheet Then
Dim Answer As VbMsgBoxResult
Answer = MsgBox("You are about to copy " & ActiveSheet.Name & " occupancy figures to the following month." & _
VBA.Constants.vbNewLine & "WARNING: THIS ACTION CAN NOT BE UNDONE!", vbOKCancel + vbQuestion + vbDefaultButton2, _
ActiveSheet.Name & " Occupancy Copy to Next Month")
If Answer = vbOK Then
Range("F4:F122").Copy
ReDim RemainingMonths(10 - i) As String
For x = 0 To 10 - i
RemainingMonths(x) = SheetID(x + i + 1)
Next x
Sheets(RemainingMonths()).Select
Range("F4:F122").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(CurrentSheet).Select
Else
Exit Sub
End If
Months = Join(RemainingMonths)
MsgBox "Data copied to: " & Months
End If
Next i
End Sub

[Aussiebear]

Have you considered creating an array of all the sheets minus the current sheet and using that as the collection to call?

[snb]

that when the data is pasted, it gets pasted on to multiple sheets at the same time.

This means you are creating a lot of redundancy.
Why using automation if you keep thinking in paper instead of databases ?
Similar data should be entered into 1 (only 1) worksheet.
The presentation of data per month should be performed in another worksheet, containing 1 (only 1) pivottable.

Automation means: saying goodbye to paper for Input and Throughput; only Output can be adapted to a visual presentation on paper.

In this case you want to use VBA to correct a wrong structure of Data.

[PaulyP]

Thanks Rollis - This was flawless.

Thank you for tidying up my code and properly declaring my variables :)



ReDim RemainingMonths(10 - i) As String
For x = 0 To 10 - i
RemainingMonths(x) = SheetID(x + i + 1)
Next x



I tried something like this but I could never get it to work and I see why now with you using ReDim instead of just Dim which is why it wouldn't work for me.

Though how this part worked I liked

For x = 0 To 10 - i
RemainingMonths(x) = SheetID(x + i + 1)

Thanks for that :)

I also wouldn't have got anywhere without the option explicit.

Thanks for the Msgbox for December, but what I decided to do instead was just not put the marco buttons on the last sheet.

Finally, I made one small change to your code to put the ReDim statement higher up so I could use the Months list in the first warning msg box... Oh and I adjusted the order of the months as I was meant to be doing the financial year, not the calendar year - my mistake in the first set of code.

This is what I ended up with and seems to work perfectly unless you can see any possible issues in how I rearranged.



Option Explicit


Sub Copy_Occupied_Status_TO_All_Subsequent_Months()

Dim CurrentSheet, i, x
Dim Months As String

CurrentSheet = ActiveSheet.Name

Dim SheetID(11) As String

SheetID(0) = "April"
SheetID(1) = "May"
SheetID(2) = "June"
SheetID(3) = "July"
SheetID(4) = "August"
SheetID(5) = "September"
SheetID(6) = "October"
SheetID(7) = "November"
SheetID(8) = "December"
SheetID(9) = "January"
SheetID(10) = "February"
SheetID(11) = "March"

For i = 0 To 10

If SheetID(i) = CurrentSheet Then


ReDim RemainingMonths(10 - i) As String

For x = 0 To 10 - i
RemainingMonths(x) = SheetID(x + i + 1)
Next x

Months = Join(RemainingMonths)

Dim Answer As VbMsgBoxResult
Answer = MsgBox("You are about to copy " & ActiveSheet.Name & " occupancy figures to ALL subsequent months:" _
& VBA.Constants.vbNewLine & VBA.Constants.vbNewLine & _
"Do you want to overwrite " & Months & "'s occupancy figures with the data from " & ActiveSheet.Name & "?" & _
VBA.Constants.vbNewLine & VBA.Constants.vbNewLine & _
"WARNING: THIS ACTION CAN NOT BE UNDONE!", vbOKCancel + vbQuestion + vbDefaultButton2, ActiveSheet.Name & " Occupancy Copy to All Following Months")

If Answer = vbOK Then
Range("F4:F122").Select
Selection.Copy

Sheets(RemainingMonths()).Select

Range("F4:F122").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(CurrentSheet).Select

Else

Exit Sub

End If

MsgBox ActiveSheet.Name & "'s data copied to: " & Months
Application.CutCopyMode = False
Range("A1").Select

End If

Next i

End Sub




Very much appreciate your time and help with this, it's saved me lots of hassle and head scratching. Thank you :clap:




Aussiebear - Thanks for the suggestion but I don't want to copy info to ALL sheets, just the sheets following the one I am currently on.

snb - Thanks for your input. The reason I have done it this way is that I am using monthly data for rental income to feed in to a budget sheet that records the actual income from the completed monthly sheets but then puts in my forecast figures in for the rest of the year.

So if I change the rent on one site in July say, I don't want to change that figure in April to June but I do want to update my forecast in all subsequent months instead of updating the rent manually on each sheet.

Many thanks for all your help everyone.

[snb]

Your argument is not valid.

In VBA your whole macro can be replaced by 2 lines VBA:


Sub M_snb()
sn = Split(Trim(ActiveSheet.Name & Split(Join(Application.GetCustomListContents(4)) & " " & Join(Application.GetCustomListContents(4)), ActiveSheet.Name)(1)))
Sheets(sn).FillAcrossSheets ActiveSheet.Range("F4:F49")
Edn Sub

[georgiboy]

If you want till the end of the financial year only then if January sheet index is 1 and December is 12 then maybe:



Sub test()
Dim N As Integer
Dim cnt As Integer
Dim arrOfWs() As Variant
Dim asInd As Integer
Dim x As Integer

asInd = ActiveSheet.Index
N = Sheets.Count

Range("F4:F49").Copy

If asInd < 4 Then
For cnt = 1 To 3
If cnt > asInd Then
ReDim Preserve arrOfWs(x): arrOfWs(x) = Worksheets(cnt).Name: x = x + 1
End If
Next cnt
Else
For cnt = 1 To N
If cnt > asInd Or cnt < 4 Then
ReDim Preserve arrOfWs(x): arrOfWs(x) = Worksheets(cnt).Name: x = x + 1
End If
Next cnt
End If

Worksheets(arrOfWs).Select
Range("F4:F49").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub