Code Improvements Excel VB Script

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

bouitac

Thread Starter
Joined
Oct 16, 2007
Messages
16
Ok, someone much smarter then I, from this forum, put this code together for me. It creates a new column C and populates it with the following formula:

"=(COUNTIF(RC[-1],""<>""&R[-1]C[-1])+COUNTIF(RC[-1],""<>""&R[1]C[-1]))"
Selection.AutoFill Destination:=Range("C2:C12000"), Type:=xlFillDefault

I would like to add the following ability:
- Delete all rows that have a value of 2 in the new C column
- Count the number of rows that have been deleted and display it
=====================================================
Sub RemoveSingles()
'
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=(COUNTIF(RC[-1],""<>""&R[-1]C[-1])+COUNTIF(RC[-1],""<>""&R[1]C[-1]))"
Selection.AutoFill Destination:=Range("C2:C12000"), Type:=xlFillDefault
Range("C2:C12000").Select
End Sub
====================================================

Thanks for Help
Bouitac
 
Joined
Jul 1, 2005
Messages
8,546
Re: code improvements:-

1. First off, you can replace these 2 lines:

Columns("C:C").Select
Selection.Insert Shift:=xlToRight


with this 1 line:

Columns("C:C").Insert Shift:=xlToRight

which (a) is one less line (b) scraps the physical selection (more efficient).

2. Re: "Delete all rows that have a value of 2 in the new C column". I can't actually decipher what your formula does, but as long as your (column C) formulas are just a temporary measure for determining which rows to dump, consider this:

If you used a construct like =IF(result=2,#N/A,result) you could then use Excel's own Go To > Special > Formulas > Errors to dump the #N/A rows in one hit.

3. If you're using the AutoFill to row 12000 to make sure you cover as many rows as there will ever be and then some, don't.

In a fresh sheet, enter 1 in B2 and 2 in B3. Then select A1. Then run this:

Range("B2", Range("B" & Rows.Count).End(xlUp)).Offset(, 1).FormulaR1C1 = "=IF(RC[-1]=2,#N/A,0)"

What it should do is create formulas in C2:C3. The things to note are (i) it figures the fill range in C from the filled range in B, rather than using a scattergun approach (ii) it does it without selecting anything.

HTH

EDIT: see Macro1 (in the attached & below), might make things clearer.

Sub Macro1()
Columns(3).Insert Shift:=xlToRight
Range("C1") = "X"
Range("B2", Range("B" & Rows.Count).End(xlUp)).Offset(, 1).FormulaR1C1 = "=IF(RC[-1]=2,#N/A,0)"
On Error Resume Next
MsgBox Columns(3).SpecialCells(xlCellTypeFormulas, 16).Count & " row(s) will be deleted."
Columns(3).SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
Columns(3).Delete
End Sub
 

Attachments

bouitac

Thread Starter
Joined
Oct 16, 2007
Messages
16
This is great!

Range("B2", Range("B" & Rows.Count).End(xlUp)).Offset(, 1).FormulaR1C1 = "=IF(RC[-1]=2,#N/A,0)"

I my current version I had to make sure to adjust the cell range to make sure it covered all rows which varied from month to month. Thanks for this great improvement.

Now in order for me to use it do I need to have sheet2? The data I need to manipulate is in sheet 1.

What I'm trying to do with this macro is to identify single line entries in the list of data and remove them

Example

James Smith jsmith 20071106
James Smith jsmith 20071106
Jim Morrison jmorri 20071106
Kim Masters kmaste 20071106
Kim Masters kmaste 20071106
Kim Masters kmaste 20071106

the
"=(COUNTIF(RC[-1],""<>""&R[-1]C[-1])+COUNTIF(RC[-1],""<>""&R[1]C[-1]))"

give me a 2 if the current cell is different from the one previous and the one after and then I delete the entries containing 2's

Is there an easier way to do this?

Bouitac
 
Joined
Jul 1, 2005
Messages
8,546
firefytr said:
Hi there,

Yes, the easier way is to use Advanced Filter for unique values. :)
Advanced Filter may be good for listing unique values, but it won't "identify single line entries in the list of data and remove them". ;)

Bouitac, with your example data in A2:A7 of a test worksheet, try this:

Sub test()
For Each Cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
If WorksheetFunction.CountIf(Range("A:A"), Cell) = 1 Then
Cell.ClearContents
x = x + 1
End If
Next Cell
On Error Resume Next
If x <> 0 Then
MsgBox x & " unique entries were found."
End If
Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
 
Joined
Jul 25, 2004
Messages
5,458
Ah, gotcha! Read it differently, but I see what you mean now.

One thing: no looping required. ;)
 
Joined
Jul 1, 2005
Messages
8,546
firefytr said:
Ah, gotcha! Read it differently, but I see what you mean now.

One thing: no looping required. ;)
How did I know you would say that? :D
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Top