Macro down fill problems

[Lostgrave2001]

Hello </SPAN>
I would appreciate any help provided </SPAN>

I currently have a spreadsheet with a table in that has the refs in column A (D0001=A11 – D0040= A50) I have the below macro that will insert another 10 blank rows in.</SPAN>
“Sub Insert_New_Rows()</SPAN>
For i = 1 To 10</SPAN>
Dim Lr As Integer, Fr As Integer</SPAN>
Fr = Columns("A").Find(What:="Ref", After:=Range("A10")).Row 'Searching row of "Ref" header</SPAN>
Lr = Range("A" & Fr).End(xlDown).Row 'Searching last row in Risk table</SPAN>
Rows(Lr + 1).Insert Shift:=xlDown 'Inserting new row</SPAN>
Rows(Lr).Copy 'Copying format of last row</SPAN>
Rows(Lr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row</SPAN>
Application.CutCopyMode = False 'Deactivating copy mode</SPAN>
Cells(Lr + 1, "B").Select</SPAN>
Next</SPAN>
End Sub</SPAN>

What I also wonder if it is possible for the Macro to auto fill the cells in column A so A51 =D0041 – A60 = D0060 I will need the macro to be able to add another & fill another 10 lines every time I click the button.</SPAN>

On another note I noticed that my total formula doesn’t update as I add more rows in the spread sheet could you please advise me on this as well. </SPAN>
=IF(COUNTIF(D11:D50,"Y")+COUNTIF(D11:D50,"N")=0," ",INT(((COUNTIF(D11:D50,"Y")/(COUNTIF(D11:D50,"Y")+COUNTIF(D11:D50,"N")))*100)+0.5))</SPAN>
Thanks in advance</SPAN>
Chris </SPAN>

 

[Lostgrave2001]

Hello,
I would really appreciate some help with the above.

thanks
Chris

 

[Lostgrave2001]

Hello people im still having trouble with the above, is there anyone who can assist,

Also as a further complication i need the code to also to update the formula in cell in cell D61 or cell D71 as we add more cells

the formula is as below

=IF(COUNTIF(D11:D50,"Y")+COUNTIF(D11:D50,"N")=0," ",INT(((COUNTIF(D11:D50,"Y")/(COUNTIF(D11:D50,"Y")+COUNTIF(D11:D50,"N")))*100)+0.5))

Thanks for any help in advance.
Chris

 

[ukmikeb]

Hi

May I suggest that you create a named range for this worksheet using "=OFFSET(Your sheet name!$D$11,,,COUNTA(Your sheet name!$A:$A)-10,1)" as the Refers To address.
where 10 is the number of rows in column A between A1 and A10 that are not empty (change to correct value if not 10).

Then your code could be :-

Sub Insert_New_Rows()
Dim Lr As Long, Fr As Long

Fr = Columns("A").Find(What:="Ref", After:=Range("A10")).Row 'Searching row of "Ref" header
Lr = Range("A" & Fr).End(xlDown).Row 'Searching last row in Risk table
Rows(Lr + 1).Resize(10).Insert Shift:=xlDown 'Inserting 10 new rows
Range("A" & Lr).Copy Destination:=Range("A" & Lr + 1).Resize(10) ' Create next group of reference numbers in Column A
Rows(Lr).Copy 'Copying format of last row
Rows(Lr + 1).Resize(10).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row
Application.CutCopyMode = False 'Deactivating copy mode
Cells(Lr + 1, "B").Select
Next
End Sub

To create your reference numbers in cell A11 :-

="D"&TEXT(ROW()-10,"0000")

and drag down to the last currently used cell in column A.

The updated formula for column D becomes :-

=IF(COUNTIF(your named range,"Y")+COUNTIF(your named range,"N")=0," ",INT(((COUNTIF(your named range,"Y")/(COUNTIF(your named range,"Y")+COUNTIF(your named range,"N")))*100)+0.5))

hth