How best to streamline this code?

[goldenvision]

I'm looking for some tips on how best to streamline the below portion of code.

I have it working for one worksheet ("BA Bush"). I now need to repeat this for another 16 sheets and I want to move away from having pages and pages of repeating commands. I have seen some quite nice code on this forum and I was looking for some pointers on how best to streamline this.

Thanks in advance.

In a nutshell the code is reading cell A1 which contains the current month, then dependant on that value, copies the formula from cells D4:E8 to upto 17 other cells.

Sub CopyFormulas()
'copy summary formula across BA Bush
Sheets("BA Bush").Activate
Range("D4:E8").Select
Selection.Copy
If Range("A1").Value = "01/08/2007" Then
Range("F4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/09/2007" Then
Range("F4, H4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/10/2007" Then
Range("F4, H4, J4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/11/2007" Then
Range("F4, H4, J4, L4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/12/2007" Then
Range("F4, H4, J4, L4, N4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/01/2008" Then
Range("F4, H4, J4, L4, N4, P4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/02/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/03/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/04/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/05/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/06/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/07/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/08/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4, AD4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/09/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4, AD4, AF4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/10/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4, AD4, AF4, AH4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/11/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4, AD4, AF4, AH4, AJ4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Range("A1").Value = "01/12/2008" Then
Range("F4, H4, J4, L4, N4, P4, R4, T4, V4, X4, Z4, AB4, AD4, AF4, AH4, AJ4, AK4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
End If '08/07
    End If '09/07
        End If '10/07
            End If '11/07
                End If '12/07
                    End If '01/08
                        End If '02/08
                            End If '03/08
                                End If '04/08
                                    End If '05/08
                                        End If '06/08
                                    End If '07/08
                                End If '08/08
                            End If '09/08
                        End If '10/08
                    End If '11/08
                End If '12/08
End Sub

 

[Norie]

How would you determine which cheets to run the code on and which to not run it on?

 

[goldenvision]

Norrie,
I understand what most of this is doing except this bit

Dim I As Long

    For Each ws In Worksheets
        Set rngSrc = ws.Range("D4:E8")
        Set rngDst = ws.Range("F4")
        For I = 0 To DateDiff("m", DateSerial(2007, 8, 1), ws.Range("A1"))
            If I <> 16 Then
                Set rngDst = Union(rngDst, ws.Range("F4").Offset(, I * 2))
            Else
                Set rngDst = Union(rngDst, ws.Range("AK4"))
            End If
        Next I
        rngSrc.Copy rngDst
        
    Next ws
    
End Sub

 

[goldenvision]

Norrie,
I understand what most of this is doing except this bit

Dim I As Long

For Each ws In Worksheets
Set rngSrc = ws.Range("D4:E8")
Set rngDst = ws.Range("F4")
For I = 0 To DateDiff("m", DateSerial(2007, 8, 1), ws.Range("A1"))
If I <> 16 Then
Set rngDst = Union(rngDst, ws.Range("F4").Offset(, I * 2))
Else
Set rngDst = Union(rngDst, ws.Range("AK4"))
End If
Next I
rngSrc.Copy rngDst

Next ws

End Sub

 

[goldenvision]

How would you determine which cheets to run the code on and which to not run it on?

The structure of the workbook is
Summary Sheet,
Sheet1 - run code on this
Sheet1 Detail
Sheet2 - run code on this
Sheet2 Detail etc
Upto Sheet16 Detail
(The sheets do have proper names it just refers to client sensitive data)

 

[Norie]

Well what you appear to be doing in your code is creating a range based on the number of months from 1/08/2007.

So this calculates the no of months.

DateDiff("m", DateSerial(2007, 8, 1), ws.Range("A1"))

And this creates the range.

If I <> 16 Then 
    Set rngDst = Union(rngDst, ws.Range("F4").Offset(, I * 2)) 
Else 
    Set rngDst = Union(rngDst, ws.Range("AK4")) 
End If

So lets say the date in A1 is 01/11/2007, that's a 3 month difference.

So the loop iterates 4 times.

The first time it unions F4 with itself resulting in F4.

The second time unions F4 with G4 resulting in F4,G4.

The third time unions F4,G4 with I4 resulting in F4,G4, I4.

The fourth time unions F4,G4,I4 with K4 resulting in F4,G4, I4.

If you are wondering about this.

If I <> 16 Then

It's there because you appear to have an anomaly when the no of months is 16.

All the others appear to be incrementing columns by 2 for each month but when the
months are 16 it appears to be only 1 column.

PS Does the code actually work?

It's only lightly tested and is based only on the code you posted.

PPS The reason I used Union is because you appeared to be working with non-contiguous
range, but when I look back I think you might just be able to use Resize as Peter did in his code.

 

[goldenvision]

If you are wondering about this.

If I <> 16 Then

It's there because you appear to have an anomaly when the no of months is 16.

All the others appear to be incrementing columns by 2 for each month but when the
months are 16 it appears to be only 1 column. oops a result of overzealous keying!

 

[Norie]

So are you saying that AK4 should actually be AL4 following the pattern of the rest of the code?

If so then we can drop the If End If since it's not needed.

As to skipping sheets is there anything to distinguish the sheets not to run the code on or the ones to run it on.

Do you want to exclude the Summary Sheet and every sheet where the name contains 'Detail'?

 

[goldenvision]

Sorry to be a pest, I'm just trying to get a better understanding of what the code is actually doing.

DateDiff("m", [this specifies that the value is a date?]DateSerial(2007, 8, 1)[this specifies the starting date?], ws.Range("A1"))[this specifies the location of the date?]

 

[goldenvision]

So are you saying that AK4 should actually be AL4 following the pattern of the rest of the code?

If so then we can drop the If End If since it's not needed.

As to skipping sheets is there anything to distinguish the sheets not to run the code on or the ones to run it on.

Do you want to exclude the Summary Sheet and every sheet where the name contains 'Detail'?

That's correct

 

[Norie]

Basically your right about the DateDiff apart from the first argument.

That specifies the interval, in this case months.

If you want more information select DateDiff and hit F1.

That should display context sensitive help.

As to excluding sheets, try this.

For Each ws In Worksheets
    If ws.Name <> "Summary Sheet" And InStr(ws.Name, "Detail") = 0 Then
        ' code here
    End If
Next ws