Solved

If on this sheet tab, delete it from another.

Posted on 2014-04-03
8
192 Views
Last Modified: 2014-04-07
I need help extending a macro to do one more additional step.

In the sample file, I would to search the MasterList sheet tab for any red text that is in column C, meaning that the CatCode is no longer valid. (its date is < today).
If the values in column C is < today, take the value from column A in that row and delete its corresponding row from the TemplateLayOut sheet tab.
May have to reformat the MasterList sheet tab, so the row only shows once…   it can show the same CatCode multiple times.

The goal is to get all the out-of-date items off the TemplateLayOut sheet tab, using the data on the MasterList tab
RemoveOutOfDateItems.xlsm
0
Comment
Question by:RWayneH
8 Comments
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 39975474
This worked for me.
Public Sub ClearOutOld()
    Dim wksML As Worksheet
    Dim wksTLO As Worksheet
    Dim dicUnique As Object
    Dim rngML As Range
    Dim rngTLO As Range
    Dim rngCell As Range
    Dim vItem As Variant
    Dim lngRow As Long
    Set dicUnique = CreateObject("scripting.dictionary")
    Set wksML = Worksheets("MasterList")
    Set rngML = wksML.Range(wksML.Range("A2"), wksML.Range("A2").End(xlDown))
    For Each rngCell In rngML
        If CDate(Replace(rngCell.Offset(0, 2).Value, "EST", vbNullString)) < Date Then
            If dicUnique.exists(rngCell.Value) Then
            Else
                dicUnique.Add rngCell.Value, 1
            End If
        End If
    Next
    Set wksTLO = Worksheets("TemplateLayOut")
    Set rngTLO = wksTLO.Range("A5").End(xlDown)
    For lngRow = rngTLO.Row To 4 Step -1
        If dicUnique.exists(wksTLO.Cells(lngRow, 1).Value) Then
            wksTLO.Rows(lngRow).Delete
        End If
    Next
End Sub

Open in new window

0
 
LVL 39

Expert Comment

by:nutsch
ID: 39975484
A different approach from aikimark, based on formulas and filters, rather than dictionaries and loops. Nothing wrong with his approach, but I wrote this code so I might as well post it.

Thomas

Sub macroClean()

Dim lLastRow As Long

lLastRow = Sheets("MasterList").Cells(Rows.Count, 1).End(xlUp).Row

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

With Sheets("TemplateLayOut")
         
    With .Range("T5:T" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        .FormulaR1C1 = _
            "=SUMPRODUCT((MasterList!R2C1:R" & lLastRow & "C1=TemplateLayOut!RC[-19])*1*(--(LEFT(MasterList!R2C3:R" & lLastRow & "C3,10))<TODAY()))"
        .Value = .Value
    End With
    
    With .Range("$A$4:T" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        .AutoFilter
        .AutoFilter Field:=20, Criteria1:=">0"
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
    
    .Columns("T").Delete

End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

Open in new window

0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39975621
How about this:
Sub Demo()

    Dim rngMasterList As Range, cMasterList As Range
    Dim rngTemplateLayOut As Range, cTemplateLayOut As Range
    Dim arrExpiredRows() As String
    Dim i As Integer
    Dim wsTemplateLayOut As Worksheet

    Set rngMasterList = Range("C2:C" & Range("C1048576").End(xlUp).Row)
    Set wsTemplateLayOut = Sheets("TemplateLayOut")
    Set rngTemplateLayOut = wsTemplateLayOut.Range("A5:A" & Range("A1048576").End(xlUp).Row)

    ReDim Preserve arrExpiredRows(0 To 1)
    
    Sheets("MasterList").Activate
    
    For Each cMasterList In rngMasterList.Cells
        If CDate(Left(cMasterList.Value, 16)) < Now() Then
            ReDim Preserve arrExpiredRows(0 To UBound(arrExpiredRows) + 1)
            arrExpiredRows(UBound(arrExpiredRows)) = Range("A" & cMasterList.Row).Value
        End If
    Next

    For i = LBound(arrExpiredRows) To UBound(arrExpiredRows)
        For Each cTemplateLayOut In rngTemplateLayOut
            If cTemplateLayOut.Value = arrExpiredRows(i) Then
                cTemplateLayOut.EntireRow.Delete
            End If
        Next
    Next

End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 39975626
@Thomas

I was originally going to create a criteria filter for the deletion, but the dictionary was quicker.  The ease-of-implementation was the non-datetime format of column C (Valid Until) data.

For future readers:
1. create a new worksheet
2. copy A:C from MasterList to the new worksheet
3. find/replace " EST" -> "" in the Valid Until cells in the new worksheet
4. Create a criteria range in H1:I2 in the new worksheet
Example using today's date
Cat Code	Valid Until
        	<4/3/2014

Open in new window

5. Apply an advanced filter to copy the unique values to E1 in the new worksheet with the criteria range from 4.
6. Apply an advanced filter in the TemplateLayOut worksheet, using the new_worksheet.range("E1"),newworksheet.range("E1").End(xldown) range
7. Delete the visible rows in the filtered TemplateLayOut worksheet.
8. Delete the newworksheet
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 45

Expert Comment

by:aikimark
ID: 39975638
Note: The first criteria range on the new worksheet can also be the one Valid Until column.  The Cat Code is superfluous in this algorithm description.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 39975651
While it would be possible to have done the filtering in the MasterList sheet, I'm not comfortable offering solutions that mess with production data.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 39975683
While my posted code iterates the cells of the MasterList, I could have transferred these values into a variant array in a single statement. Iterating the variant array is much faster than iterating the cells in a range.

I do this in my Better Concatenate Function article:
http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html

This is the inverse operation I describe in my Fast Data Push to Excel article:
http://www.experts-exchange.com/A_2253.html
0
 

Author Closing Comment

by:RWayneH
ID: 39983075
Worked great for me too.  Thanks. for the help. EXCELent!!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
highlight duplicate entry 16 30
Compile Error 7 41
DBF to ... Converter 5 40
Auto Adjust Percent rate 5 29
Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now