AutoFilter, Fill Down, Absolute Values

Hi,

pls try

    ActiveSheet.Range("$A$1:$D$440").AutoFilter Field:=3, Criteria1:="=", _
                    Operator:=xlOr, Criteria2:="CUSTOM/SPECIAL"
    For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        c.FormulaR1C1 = "SERVICE PART                                    "
    Next

Select allOpen in new window

Regards

I can have an absolute value in the code, because they are different.  Is there a way to take that out?  -R-

Could you explain?

Yes, after the filter is applied, based on that filter, a different columns data needs to chg.  So I go to that column, select the top cell, (which now make it absolute value in the macro) and need to copy that down to only the result of the filter rows.

the Range("$A$1:$D$440"). in your reply can be different each time.  Does that help? -R-

Hi,

If you mean the number of rows is not predetermined

try

ActiveSheet.Range(Range("A1"), Range("D" & Cells.Rows.Count).End(xlUp)).AutoFilter Field:=3, Criteria1:="=", _
                    Operator:=xlOr, Criteria2:="CUSTOM/SPECIAL"
    For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        c.FormulaR1C1 = "SERVICE PART                                    "
    Next

Select allOpen in new window

if you mean that you do not know which column you will first filter, how do you determine it?

Well for each sheet tab that I need to use this on the range will be different.  Are you saying that I have to manually figure out what the range is on that sheet and then edit the macro to work on each sheet tab?

Can we edit the macro to have it determine the autofilter area first?
Then I can insert the Autofilter command.  In this example it is:
.AutoFilter Field:=3, Criteria1:="="
Then for anything that is blank in field 3, and "SERVICE PART" on the rest of the cells, provided there is any.  If there is none, stop and continue macro.  -R-

Hi,

Maybe at best, you could send a dummy example with different Sheets

Regards

hi,

The following code doesn't include any looping to coverdifferent sheets but it may give you some ideas (esp the section relating to Visclls). Does it help you?

    Option Explicit
    
    Sub Pull_ZSHORTV2_MM17NoDupsData_v2()
    Const ColToFilter As Long = 3
    Dim ws As Worksheet
    Dim AfRng As Range
    Dim AfDataOnlyRng As Range
    Dim VisClls As Range
    
    
        Application.DisplayAlerts = False
        Sheets("ZSHORTV2_MM17NoDups").Delete
        Application.DisplayAlerts = False
    
        'Get new file
        ChDir "C:\_SAP\ShortageRpt\DefaultExtractFiles"
        Workbooks.OpenText Filename:= _
                           "C:\_SAP\ShortageRpt\DefaultExtractFiles\ZSHORTV2_MM17NoDups.txt", Origin:= _
                           xlWindows, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
                           xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
                                                                                              , Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
                                                                                                                                                         :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                           TrailingMinusNumbers:=True
    
        Set ws = ActiveSheet
    
        With ws
            .Range("1:1,3:3").Delete Shift:=xlUp
            .Columns("A:A").Delete Shift:=xlToLeft
            .Cells.EntireColumn.AutoFit
    
            ''to include populated rows on the sheet (down to the first blank row within the data) in the autofilter range
            '    Set AfRng = .Rows("1:1")
            'to include all populated rows on the sheet in the autofilter range
            Set AfRng = .Range(.Cells(1, 1), LastCell(ActiveSheet))
        End With
    
        With AfRng
            Set AfDataOnlyRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
        End With
    
        With AfRng
            'note this doesn't check for any other filters (before applying the below filtering criteria), do you need it to?
            .AutoFilter Field:=ColToFilter, Criteria1:="=", _
                        Operator:=xlOr, Criteria2:="CUSTOM/SPECIAL"
    
            On Error Resume Next
            Set VisClls = AfDataOnlyRng.Columns(ColToFilter).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
    
            If Not VisClls Is Nothing Then
                VisClls.Value2 = "SERVICE PART"
            End If
            .AutoFilter Field:=ColToFilter
        End With
    
        MsgBox "Done"
        Set VisClls = Nothing
        Set AfDataOnlyRng = Nothing
        Set AfRng = Nothing
        Set ws = Nothing
    
    End Sub
    
    Function LastCell(ws As Excel.Worksheet) As Excel.Range
    '22/09/2013, RB: written as "Function AttemptAtARobustLastCellFinder_v4(ws As Worksheet) As Range" for:
    'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39474286
    'inspired by FP's comments about a "binary chop" approach http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380467
    'still subject to the limitations of CountA which Qlemo mentioned: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380520
    
    Dim PercentArr As Variant    'this can probably be written better
    Dim PercentageMultiplier As Double
    Dim PercentInd As Long    'percent loop index
    Dim LastRow As Long
    Dim LastCol As Long
    Dim RowsInWs As Long
    Dim ColsInWs As Long
    Dim LoopInd As Long
    Dim UpperLim As Long
    Dim BlockSizer As Long
    Dim FirstRowOfUsedRng As Long
    
        With ws
            RowsInWs = .Rows.Count
            ColsInWs = .Columns.Count
        End With
        PercentArr = Array(0.5, 0.3, 0.1, 0.05, 0.03, 0.01, 0.005, 0.003, 0.001, 1)
    
        'run a loop to find the last row
        'v4, amended in case the first row of the used range is not Row 1.
        With ws.UsedRange
            UpperLim = Application.WorksheetFunction.Min(RowsInWs, .Cells(1, 1).Row - 1 + .Rows.Count)
        End With
    
        For PercentInd = LBound(PercentArr) To UBound(PercentArr)
    
            PercentageMultiplier = PercentArr(PercentInd)
            If PercentageMultiplier <> 1 Then
                BlockSizer = PercentageMultiplier * RowsInWs
            Else
                BlockSizer = 1
            End If
    
            For LoopInd = UpperLim To 1 Step -BlockSizer
                If (LoopInd - BlockSizer + 1) > 0 Then
                    If Application.CountA(ws.Range(LoopInd - BlockSizer + 1 & ":" & LoopInd)) Then
                        Exit For
                    End If
                Else
                    Exit For
                End If
            Next LoopInd
    
            UpperLim = LoopInd
        Next PercentInd
    
        'v4: .max is used to allow for empty sheets
        LastRow = Application.WorksheetFunction.Max(1, UpperLim)
    
        'run a loop to find the last column
        'v4, amended in case the first column of the used range is not column 1.
        With ws.UsedRange
            UpperLim = Application.WorksheetFunction.Min(ColsInWs, .Cells(1, 1).Column - 1 + .Columns.Count)
        End With
        For PercentInd = LBound(PercentArr) To UBound(PercentArr)
    
            PercentageMultiplier = PercentArr(PercentInd)
            If PercentageMultiplier <> 1 Then
                BlockSizer = PercentageMultiplier * ColsInWs
            Else
                BlockSizer = 1
            End If
    
            For LoopInd = UpperLim To 1 Step -BlockSizer
                If (LoopInd - BlockSizer + 1) > 0 Then
                    With ws
                        'Searches entire columns
                        'v4 corrected as per http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39392583
                        If Application.CountA(.Range(.Cells(1, LoopInd - BlockSizer + 1), .Cells(RowsInWs, LoopInd))) Then
                            Exit For
                        End If
                    End With
                Else
                    Exit For
                End If
            Next LoopInd
    
            UpperLim = LoopInd
        Next PercentInd
    
        'v4: .max is used to allow for empty sheets
        LastCol = Application.WorksheetFunction.Max(1, UpperLim)
    
        '    'User feedback for testing
        Debug.Print "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address
        '    MsgBox "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address
    
        Set LastCell = ws.Cells(LastRow, LastCol)
    
    End Function

Select allOpen in new window

hth
Rob

To be honest I did not follow your reply.  Here is a section of code that is working off a filter that is already been applied.  It needs to replace whatever is in filtered (provided it found something) in column C, by putting the word SERVICE PART in there.  There is also a VLOOKUP that is filtered also (that could result in nothing found) it needs the word SERVICE PART put in column C, based on findings from the VLOOKUP

Sub LeftToAutomateOnMM17Data()
'
'A prior macro autofiltered a list, based on autofilter
'change the value everything filter caught to SERVICE PART


'This prior filter could result in nothing.
'The C643 just happen to be the starting point from the autofilter next record down
    Range("C643").Select
    ActiveCell.FormulaR1C1 = "SERVICE PART"
    Range("C643").Select
    Selection.FillDown
    ActiveSheet.ShowAllData
        
'Add VLOOKUP and filter, this could also result in nothing.
    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-3],AdditionalServiceMatls!C[-3]:C[-1],3,FALSE)"
'Copies the formula in D2 down column D, as long as there is a value in columnB
'Removes formulas CopySpecialPaste>ValuesAndNumberFormats
    Set myRange = Range(Range("D2"), Range("D" & Range("B2").End(xlDown).Row))
    Range("D2").AutoFill Destination:=myRange
'Autofilter on a VLOOKUP formula
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:= _
        "SERVICE PART"
    Range("C19").Select
    ActiveCell.FormulaR1C1 = "SERVICE PART"
    Range("C19").Select
    Selection.FillDown
    Range("C971").Select
    ActiveSheet.ShowAllData
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Selection.AutoFilter
End Sub

Select allOpen in new window

hi RWayneH,

was it my reply that you didn't follow?

The code I posted in my previous post should be functionally the same as the code in your original post. However, I have removed the ".select" etc which are included by the macro recorder but can be unnecessary when the code is optimised to be more efficient. Ranges can usually be acted on directly without being selected or activated.

I have added comments which explain each step of my code & labelled them with "v3...". I hope that this makes it more understandable. I'll have a go at modifying your newest code when I get a chance.

Option Explicit

Sub Pull_ZSHORTV2_MM17NoDupsData_v3()
'v3, RB: this macro is a modified version of the code that was in your original post of this thread.

Const ColToFilter As Long = 3    'v3, RB: ColToFilter = column to filter

Dim ws As Worksheet
Dim AfRng As Range    ' 'v3, RB: AFRng = Autofilter range
Dim AfDataOnlyRng As Range    'v3, RB: AFDataOnlyRange = autofilter data only range (ie it excludes the header row)
Dim VisClls As Range    ''v3, RB: VisClls = visible cells in a range

    'v3, RB: delete the sheet (there's no need to select it first).
    'I have assumed that it is in the "activeworkbook".
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("ZSHORTV2_MM17NoDups").Delete
    Application.DisplayAlerts = False

    'Get new file
    ChDir "C:\_SAP\ShortageRpt\DefaultExtractFiles"
    Workbooks.OpenText Filename:= _
                       "C:\_SAP\ShortageRpt\DefaultExtractFiles\ZSHORTV2_MM17NoDups.txt", Origin:= _
                       xlWindows, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
                       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
                                                                                          , Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
                                                                                                                                                     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                       TrailingMinusNumbers:=True
    ''v3, RB: create a variable for the worksheet that is being worked on
    '(just in case the worksheet is referred to more than once).
    Set ws = ActiveSheet

    ''v3, RB: use a With statement to group all the actions relating to the worksheet (ws).
    'There is often no need to select ranges before performing an action on them.
    With ws
        .Range("1:1,3:3").Delete Shift:=xlUp
        .Columns("A:A").Delete Shift:=xlToLeft
        .Cells.EntireColumn.AutoFit

        ''to include populated rows on the sheet (down to the first blank row within the data) in the autofilter range
        '    Set AfRng = .Rows("1:1")
        'to include all populated rows on the sheet in the autofilter range

        'v3, RB: this variable identifies the Autofilter range.
        'v3, RB: the section "LastCell(activesheet)" generates a call to the Function which is listed below this macro (see '***********).
        'v3, RB: The function identifies the real "last populated cell" on a worksheet & can identify if data is contained within hidden/filtered rows.
        Set AfRng = .Range(.Cells(1, 1), LastCell(ActiveSheet))
    End With

    With AfRng
        'v3, RB: the "offset(1,0)" means that the header row isn't included in the variable
        'v3, RB:& the "-1" adjusts for the size of the data set when the header row is excluded.
        Set AfDataOnlyRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
    End With

    With AfRng
        'note this doesn't check for any other filters (before applying the below filtering criteria), do you need it to?
        .AutoFilter Field:=ColToFilter, Criteria1:="=", Operator:=xlOr, Criteria2:="CUSTOM/SPECIAL"


'v3, RB: &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& this section relates to checking for visible cells & then performing an action.
        
        'v3, RB: this variable is assigned any visible cells of the autofilter range which has had the filter applied.
        'v3, RB: the "on error..." prevents the code from crashing if there are no visible cells.
        On Error Resume Next
        Set VisClls = AfDataOnlyRng.Columns(ColToFilter).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0

        'v3, RB: this checks if any visible cells were assigned to the variable & then changes the values to "SERVICE PART".
        If Not VisClls Is Nothing Then
            VisClls.Value2 = "SERVICE PART"
        End If
        'v3, RB: this line removes the filter that was applied during this macro
        .AutoFilter Field:=ColToFilter
    End With
'v3, RB: &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

    MsgBox "Done"
    Set VisClls = Nothing
    Set AfDataOnlyRng = Nothing
    Set AfRng = Nothing
    Set ws = Nothing

End Function

'***********v3, RB: The LastCell function identifies the real "last populated cell" on a worksheet & can identify if data is contained within hidden/filtered rows.
'v3, RB: this is a fast & reliable way of finding the last cell. If you want to understand more about it please see the URL which is in the second line of comments.

Function LastCell(ws As Excel.Worksheet) As Excel.Range
'22/09/2013, RB: written as "Function AttemptAtARobustLastCellFinder_v4(ws As Worksheet) As Range" for:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39474286
'inspired by FP's comments about a "binary chop" approach http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380467
'still subject to the limitations of CountA which Qlemo mentioned: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380520

Dim PercentArr As Variant    'this can probably be written better
Dim PercentageMultiplier As Double
Dim PercentInd As Long    'percent loop index
Dim LastRow As Long
Dim LastCol As Long
Dim RowsInWs As Long
Dim ColsInWs As Long
Dim LoopInd As Long
Dim UpperLim As Long
Dim BlockSizer As Long
Dim FirstRowOfUsedRng As Long

    With ws
        RowsInWs = .Rows.Count
        ColsInWs = .Columns.Count
    End With
    PercentArr = Array(0.5, 0.3, 0.1, 0.05, 0.03, 0.01, 0.005, 0.003, 0.001, 1)

    'run a loop to find the last row
    'v4, amended in case the first row of the used range is not Row 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(RowsInWs, .Cells(1, 1).Row - 1 + .Rows.Count)
    End With

    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * RowsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                If Application.CountA(ws.Range(LoopInd - BlockSizer + 1 & ":" & LoopInd)) Then
                    Exit For
                End If
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastRow = Application.WorksheetFunction.Max(1, UpperLim)

    'run a loop to find the last column
    'v4, amended in case the first column of the used range is not column 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(ColsInWs, .Cells(1, 1).Column - 1 + .Columns.Count)
    End With
    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * ColsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                With ws
                    'Searches entire columns
                    'v4 corrected as per http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39392583
                    If Application.CountA(.Range(.Cells(1, LoopInd - BlockSizer + 1), .Cells(RowsInWs, LoopInd))) Then
                        Exit For
                    End If
                End With
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastCol = Application.WorksheetFunction.Max(1, UpperLim)

    '    'User feedback for testing
    Debug.Print "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address
    '    MsgBox "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address

    Set LastCell = ws.Cells(LastRow, LastCol)

End Function

Select allOpen in new window

hth
Rob

Your code worked perfectly.. however I really would like to understand it more so I can edit and reuse it for other applications...

Idea is that I would set the autofilter or vlookup, and then I could provide the column to edit and the value that we need to put there and change.  (adding the option to delete rows that are visible would be awesome!!)  Perhaps I could comment out the delete, and when needed I can replace the column to edit with the delete?

Is there a way to highlight the places in your code that would need to chg in order to produce the same result in a different use?  Does this allow for filters that not return any results?  I did not test that yet..

Better yet, perhaps I could strip out all my code, and just focus on yours.  I like the assuming the autofiler or vlookup has been applied, because then all I need to do is provide the column, value to change to, or a delete flag. (as Dim definations?)  Perhaps this also will help me understand the code better?  Would that be too much to ask for?  Please advise and thanks. -R-

hi,

Did you know that you can place the cursor just inside a Sub and then press the [F8] key repeatedly to "step through" the code line by line?

Doing this slowly & attempting to understand what each line of code is doing as you press [F8] should help you improve your understanding. Especially if you do it in conjunction with reading all my explanatory comments because there are almost as many lines of explanatory comments as there are lines of code.


Try this approach & then you can post questions if you need extra clarification.

In response to your questions:
- Yes, you could comment out a delete command but it would be better to have a "delete  flag" instead of having to comment & uncomment a line of code.
- In my first code, I used a Constant to show one of the requirements that you could change, but would stay the same (ie constant) when the code was running. I took this constant out in the second lot of code because I started to see that you wanted more flexibility. As you start to read & understand the code, it will become clearer which areas need to be changed (or be made more flexible) to allow for the code to be used in different situations.
- Yes, it checks for times when there are no visible results. See the sections that contain "VisClls" (my shorthand for visible cells).
- Using [F8] to go through the code is one of the best ways to get a better understanding.
- Post back if you have any questions as you try to generalise the code & I can help out. Asking for a general solution is changing the scope of the original question & although it is not "too much to ask" I would rather help you learn (than just giving you the answer).

Rob
Always learning & the best way to learn is to experience...

Thanks and makes sense.  I have stepped through the code a few times and have printed it out to write my own comments on it.   I think the keys is being able to set the filter or vlookup and then make the edits... I have a lot that are deletes instead of edits in a column, some are edits in multiple columns which can get complicated.  I will review a little more and comment back. -R-

EXCELent!!  Worked and tested great.. thanks for the help. -R-

Fantastic, I hope you were able to understand the code as you stepped through it line by line. If you did understand it you should find it easier to adapt the code for other projects :-)


Rob