Macro/ VbA Forumla Help-Deleteing Entire RowsClosed

Question

Hello everyone,

In Excel 2007...

I'm looking for a function/ macro/ VBA formula that can assist me in scanning one set column (but the numbers vary upon many different one at a time, top to bottom of the specified column. Starting from the top if the two equaled 0, then it would entirely delete Rows 1 and 2 from the spreadsheet. In this particular situation it would be summing positive and negative numbers. It would continue on as a loop through the column until it reached the bottom of the data in the column. 
And it would be even better if there was a formula that would loop back to start at the top of the column after it deleted two rows. This would allow all numbers to be fully tested that come after one another.




For example:
  The formula/ macro/ VBA formula would scan column "F" to logically add F1 and F2 first. If F1 and F2 = 0, then it would delete the entire rows of 1 and 2 from the spreadsheet. And from there it would continue on down column F to add F2 & F3 to see if it equaled 0 and delete rows 2 and 3 if F2 & F3 equaled (But, of course F1 and F2 had not equaled 0 for it compare the original F2 and F3). It would loop all the way to the bottom and deleting rows until it reached the bottom of the data in the column.

Any help would be greatly appreciated.

Thanks

venkat1926 · Answer

Sub test()  
Dim j As Integer  
For j = Range("F1").End(xlDown).Row To 2 Step -1  
If Cells(j, "F") + Cells(j - 1, "F") = 0 Then  
Range(Cells(j, "F"), Cells(j - 1, "F")).EntireRow.Delete  
End If  
Next j  
End Sub  


DO THIS EXPERIMENT IN A SAMPLE DATA FIRST.WHEN YOU DO IT IN ORIGINAL FILE DO IT ON A COPY OF THE ORIGINAL FILE AND NOT ORIGINAL FILE.

dumow880 · Answer

Thanks a ton, it works and I really appreciate it. Big time saver.

However, I do have one more question in regards to the formula: 

After it runs and completes the task it retruns the error message: "Run-time error '13'  Type Mismatch". I click Debug and it pulls up the Microsoft Visual Basic Module. Highlighted is the fourth line of programming, "If Cells(j, "F") + Cells(j - 1, "F") = 0 Then", with a yellow arrow facing it and the row highlighted yellow. 

What is this error message saying?

venkat1926 · Answer

I think you are having a header row in row no;. 1



in which case replace this statement  in the macro 

For j = Range("F1").End(xlDown).Row To 2 Step -1

by 
For j = Range("F1").End(xlDown).Row To 3 Step -1

dumow880 · Answer

Works great; thanks a lot.

One last question, but on macro I currently have.

Listed below is the Macro. Currently it has a set "range" to autofill ("H2:H8000"). What is the appropriate programming string to have it just fill to the end of the data in Column H, instead of having a defined H2:H8000?

Thanks
------------ 

Sub ThirdStep()

    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],""dup"",0)"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H8000")
    Range("H2:H8000").Select
    Columns("H:H").Select
    Selection.Copy
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Selection.ColumnWidth = 8.29
    Range("G7").Select

End Sub

venkat1926 · Answer

use the statement 

range(range("H2"),cells(rows.count,"H").end(xlup)).select

this will work even if the re are gaps in c;column H

one more thing do not select unnecessarily 

for example use something like this

dim r as range
set  r=range(range("H2"),cells(rows.count,"H").end(xlup))
r.copy 
etc etc.

dumow880 · Answer

Thanks Venkat1926.

So if I'm following correctly, the final macro would read:

Sub Scan_column()

dim r as range
set  r=range(range("H2"),cells(rows.count,"H").end(xlup))
r.copy 

End Sub

Macro/ VbA Forumla Help-Deleteing Entire Rows

6 responses

Similar discussions

Subscribe To Our Newsletter!