1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Code Improvements Excel VB Script

Discussion in 'Business Applications' started by bouitac, Nov 6, 2007.

Thread Status:
Not open for further replies.
Advertisement
  1. bouitac

    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
     
  2. bomb #21

    bomb #21

    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
     

    Attached Files:

  3. bouitac

    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
     
  4. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    Hi there,

    Yes, the easier way is to use Advanced Filter for unique values. :)
     
  5. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    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
     
  6. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    Ah, gotcha! Read it differently, but I see what you mean now.

    One thing: no looping required. ;)
     
  7. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    How did I know you would say that? :D
     
  8. Sponsor

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 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/648656

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice