Help with macro shortening

Hi All,

I'm working on a little project for a friend and the below macro is one of two macros that are my final sticking points. My Questions with this macro are - can the below be simplified? & I need to repeat this macro to a further 14 times, moving the cell selection down 15 rows each time (with the exception of the final 2 points - inputing day, month, year, input name & changing sheet & saving) - is there an easy way to do this?

    Range( _
        "W16:X19,T16:U19,Q16:R19,N16:O19,K16:L19,H16:I19,E16:F19,D10:E10,G10:H10,J10:K10,M10:N10,P10:Q10,S10:T10,V10:W10" _
        ).Select
    Selection.ClearContents
    
    Range("D20:F20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("D21:F21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("D22:F22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G20:I20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G21:I21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G22:I22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("J20:L20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("J21:L21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("J22:L22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("M20:O20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("M21:O21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("M22:O22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("P20:R20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("P21:R21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("P22:R22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("S20:U20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("S21:U21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("S22:U22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("V20:X20").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("V21:X21").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("V22:X22").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("D10:E10").Select
    
    Range("Q5:Q6").Select
    ActiveCell.FormulaR1C1 = "Day"
    Range("R5:T6").Select
    ActiveCell.FormulaR1C1 = "Month"
    Range("U5:U6").Select
    ActiveCell.FormulaR1C1 = "Year"
    Range("AF5:AG6").Select
    ActiveCell.FormulaR1C1 = "INPUT NAME"
    Range("D10:E10").Select

    Sheets("Menu").Select
    ActiveWorkbook.Save

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution.

Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.

To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Changed as requested - the original title was my problem - I need to know if I can make the macro simpler.

Code tags added

Does this help (didn't test)

Range( _
        "W16:X19,T16:U19,Q16:R19,N16:O19,K16:L19,H16:I19,E16:F19,D10:E10,G10:H10,J10:K10,M10:N10,P10:Q10,S10:T10,V10:W10" _
        ).ClearContents
    
    Range("D20:X2").value = 0
    
    Range("Q5:Q6").value = "Day"
    Range("R5:T6").value = "Month"
    Range("U5:U6").value = "Year"
    Range("AF5:AG6").value = "INPUT NAME"

    ActiveWorkbook.Save

This works spot on... slight change of in range for value but perfect - thank you - Zbor.

Is there a way to duplicate 14 times, moving it on 15 rows at a time?

Originally Posted by zbor

Does this help (didn't test)

Range( _
        "W16:X19,T16:U19,Q16:R19,N16:O19,K16:L19,H16:I19,E16:F19,D10:E10,G10:H10,J10:K10,M10:N10,P10:Q10,S10:T10,V10:W10" _
        ).ClearContents
    
    Range("D20:X22").value = 0
    
    Range("Q5:Q6").value = "Day"
    Range("R5:T6").value = "Month"
    Range("U5:U6").value = "Year"
    Range("AF5:AG6").value = "INPUT NAME"

    ActiveWorkbook.Save

Boost..........

Do you mean something like:

Dim i as integer

For i = 0 to 14
Range( _
        "W16:X19,T16:U19,Q16:R19,N16:O19,K16:L19,H16:I19,E16:F19,D10:E10,G10:H10,J10:K10,M10:N10,P10:Q10,S10:T10,V10:W10" _
        ).ClearContents
    
    Range("D20:X22").offset(15*i).value = 0
    
    Range("Q5:Q6").offset(15*i).value = "Day"
    Range("R5:T6").offset(15*i).value = "Month"
    Range("U5:U6").offset(15*i).value = "Year"
    Range("AF5:AG6").offset(15*i).value = "INPUT NAME"

    ActiveWorkbook.Save
next i

Thank you Zbor, this is pretty close !!!

This does do the "zeroing", date & name but with the first range selected to clear contents, I also need that to move down the sheet in the same way.

Thanks for all your help so far.

Add offset alse there:

Dim i as integer

For i = 0 to 14
Range("W16:X19,T16:U19,Q16:R19,N16:O19,K16:L19,H16:I19,E16:F19,D10:E10,G10:H10,J10:K10,M10:N10,P10:Q10,S10:T10,V10:W10").offset(15*i).ClearContents
    
    Range("D20:X22").offset(15*i).value = 0
    
    Range("Q5:Q6").offset(15*i).value = "Day"
    Range("R5:T6").offset(15*i).value = "Month"
    Range("U5:U6").offset(15*i).value = "Year"
    Range("AF5:AG6").offset(15*i).value = "INPUT NAME"

    ActiveWorkbook.Save
next i

This is spot on Zbor,

Thank you for your help with this.