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

 

[goldenvision]

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

If the worksheet name isn't Summary Sheet and the worksheet name doesn't contain the word "Detail" then process the code?

Sorry for having to keep breaking the code down like this but once it is in the grey matter it is in there for good.

 

[Norie]

You've got it in one.

 

[goldenvision]

Norrie,
Thanks for all of your help on this.

It's now seems to be working

 

[Peter_SSs]

Very good Peter, except I would have used this to get "Multiple":

Multiple= DateDiff("m", #7/1/2007#, Range("A1"))

Thanks Glenn, to be honest, I wasn't aware of the vba DateDiff function.


Goldenvision

Looks like while I have been asleep, you have achieved a satisfactory outcome. However, since it seems all your "paste ranges" are adjacent to each other, I can't see any reason to "loop" to achieve the result (Norie did refer to this in one of his posts).

This would be my suggestion:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CopyFormulas()
    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> Multiple <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> Worksheets
        <SPAN style="color:#00007F">If</SPAN> ws.Name <> "Summary Sheet" And InStr(ws.Name, "Detail") = 0 <SPAN style="color:#00007F">Then</SPAN>
            <SPAN style="color:#00007F">With</SPAN> ws
                Multiple = DateDiff("m", DateSerial(2007, 7, 1), .Range("A1").Value)
                .Range("D4:E8").Copy Destination:=.Range("F4").Resize(5, Multiple * 2)
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> ws
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>


Whichever code you use, you certainly got the "streamlining" you originally requested! I wonder if you would have imagined the code would be reduced so much?

 

[goldenvision]

108 lines versus 12 lines

That's the difference between knowing how to make Excel do something and knowing how to make Excel do something properly.

It's all a learning curve I suppose.

Thanks to all who contributed to this post.

 

[GlennUK]

Very good Peter, except I would have used this to get "Multiple":

Multiple= DateDiff("m", #7/1/2007#, Range("A1"))

Thanks Glenn, to be honest, I wasn't aware of the vba DateDiff function.

It's one of the hidden features of Excel. I didn't know about it until a few years ago when I got web access and read about on some site or other.

 

[Peter_SSs]

It's one of the hidden features of Excel. I didn't know about it until a few years ago when I got web access and read about on some site or other.

I guess it's not that hidden. In Help (in VB window), a search for "date functions" turns it up - at least it did in my version.

 

[GlennUK]

In older versions it did not appear in the help at all. It looks like some common sense is starting to prevail.