VBA Code / Formula - Modify

[Vishaal]

Hi,

Thanks in Advance,

Its possible in VBA or code or formula to automate from column IX to column SO (ROW1798), its copy the formula and paste in only 5 or 10 column and after that copy that cells and paste special as value and make this till SO (ROW1798)

1. It will copy the formula

"=IF(AND(RC[-253]=""Na"",R[1]C[-253]=""Yes""),COUNTIF(R2C[-253]:RC[-253],""Na"")-SUM(R1C:R[-1]C),"""")"

2. Paste on range IX10:IX1798

3. Now for the range IY10 to SO10 automatically paste the formula as per following details
(i) paste in next five coloumn from "IY to JC"
(ii) copy that five coloumn (IY to JC) and paste as values

After that it will do for next five coloumns till SO10

Because its time taken for counting the "ix to so"


Currently i am using the following code



Range("IX10").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-253]=""Na"",R[1]C[-253]=""Yes""),COUNTIF(R2C[-253]:RC[-253],""Na"")-SUM(R1C:R[-1]C),"""")"
Range("IX10").Select
Selection.Copy
Range("IX11:IX1798").Select
ActiveSheet.Paste
Application.CutCopyMode = False


Sub test6()
Application.ScreenUpdating = False
Range("IX10:IX1798").Copy
Range("IY10:JW10").PasteSpecial xlPasteAll
Range("IY10:JW10").PasteSpecial xlPasteValues

Range("JX10:KV10").PasteSpecial xlPasteAll
Range("JX10:KV10").PasteSpecial xlPasteValues




Range("KW10:LU10").PasteSpecial xlPasteAll
Range("KW10:LU10").PasteSpecial xlPasteValues




Range("LV10:MT10").PasteSpecial xlPasteAll
Range("LV10:MT10").PasteSpecial xlPasteValues

Range("MU10:NS10").PasteSpecial xlPasteAll
Range("MU10:NS10").PasteSpecial xlPasteValues

Range("NT10:OR10").PasteSpecial xlPasteAll
Range("NT10:OR10").PasteSpecial xlPasteValues

Range("OS10:PQ10").PasteSpecial xlPasteAll
Range("OS10:PQ10").PasteSpecial xlPasteValues

Range("PR10:QP10").PasteSpecial xlPasteAll
Range("PR10:QP10").PasteSpecial xlPasteValues

Range("QQ10:RO10").PasteSpecial xlPasteAll
Range("QQ10:RO10").PasteSpecial xlPasteValues

Range("RP10:SO10").PasteSpecial xlPasteAll
Range("RP10:SO10").PasteSpecial xlPasteValues




Application.ScreenUpdating = True
Application.CutCopyMode = False

MsgBox "Done"
End Sub

 

[Vishaal]

any other details required.....

pls help

 

[Vishaal]

I just want to copy the formula

Range("IX10").Select

ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-253]=""Na"",R[1]C[-253]=""Yes""),COUNTIF(R2C[-253]:RC[-253],""Na"")-SUM(R1C:R[-1]C),"""")"
Range("IX10").Select
Selection.Copy
Range("IX11:IX1798").Select
ActiveSheet.Paste
Application.CutCopyMode = False

and it will work on the coloumn till SO (ROW1798),
1. Paste next five column
2. copy what we have past and paste special values
and do this till column SO (Row 1798)


like this but it have done manually

Sub test6()
Application.ScreenUpdating = False
Range("IX10:IX1798").Copy
Range("IY10:JW10").PasteSpecial xlPasteAll
Range("IY10:JW10").PasteSpecial xlPasteValues

Range("JX10:KV10").PasteSpecial xlPasteAll
Range("JX10:KV10").PasteSpecial xlPasteValues

Range("KW10:LU10").PasteSpecial xlPasteAll
Range("KW10:LU10").PasteSpecial xlPasteValues

Range("LV10:MT10").PasteSpecial xlPasteAll
Range("LV10:MT10").PasteSpecial xlPasteValues

Range("MU10:NS10").PasteSpecial xlPasteAll
Range("MU10:NS10").PasteSpecial xlPasteValues

Range("NT10:OR10").PasteSpecial xlPasteAll
Range("NT10:OR10").PasteSpecial xlPasteValues

Range("OS10:PQ10").PasteSpecial xlPasteAll
Range("OS10:PQ10").PasteSpecial xlPasteValues

Range("PR10:QP10").PasteSpecial xlPasteAll
Range("PR10:QP10").PasteSpecial xlPasteValues

Range("QQ10:RO10").PasteSpecial xlPasteAll
Range("QQ10:RO10").PasteSpecial xlPasteValues

Range("RP10:SO10").PasteSpecial xlPasteAll
Range("RP10:SO10").PasteSpecial xlPasteValues

Application.ScreenUpdating = True
Application.CutCopyMode = False

MsgBox "Done"
End Sub

 

[Vishaal]

can we use something like this

as the following formula

Sub Delete_If()
'Modified 8/26/2019 3:47:12 AM EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, 1).Value = Cells(i, 2).Value Then Rows(i).Delete
Next
Application.ScreenUpdating = True
End Sub