• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Filter and assign formula

Hi,

My below code to assign formula and after the filter does not provide the desired result. When I use the code, it gives me strange output and result. Can you please help me?

After I filter, the desired range not found, then it should skip to next . I have a huge data and multiple formula needs to apply many places. If I can get a error free code, then I can use it.

Sample file attached.

Code: 1

Code:
Sub ModificationCriteriaOSVV()
Dim rng As Range
Sheets("OSV_Vendor").Activate
Application.DisplayAlerts = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
Rws = Cells(Rows.Count, "O").End(xlUp).Row

On Error Resume Next

ActiveSheet.Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="Modification", Operator:=xlFilterValues
Set rng = ActiveSheet.Range("$A1$2:$AQ$" & Rws).SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then

Set rng = Range(Cells(2, "N"), Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then rng = "=C2&"" - ""&A2&"" - ""&O2"
End If
With ActiveSheet
.AutoFilterMode = False
End With

End Sub

Code: 2

Code:
Sub ModificationCriteriaOSVV()
Dim rng As Range
Sheets("OSV_Vendor").Activate
Application.DisplayAlerts = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
Rws = Cells(Rows.Count, "O").End(xlUp).Row

On Error Resume Next

ActiveSheet.Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="New creation", Operator:=xlFilterValues
Set rng = ActiveSheet.Range("$A1$2:$AQ$" & Rws).SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then

Set rng = Range(Cells(2, "N"), Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then rng.Value = "=C2&"" - ""&A2&"" - ""&F2&"" - ""&O2"
End If
With ActiveSheet
.AutoFilterMode = False
End With

End Sub

Also is there any easy method to apply boarder and change the Font to Arial 10 (black color)?
 

Attachments

  • Sample.xlsx
    10.5 KB · Views: 5
Last edited by a moderator:
Your On Error Resume Next is masking code syntax errors; you only need it when you know a line might throw an error such as the VisibleCells lines. Also return to normal error handling after such lines have been executed with On Error Goto 0.
It was masking this (which, as it happens, is on a VisibleCells line!):
Set rng = ActiveSheet.Range("$A1$2:$AQ$" & Rws).SpecialCells(xlCellTypeVisible)
where:
"$A1$2:$AQ$"
should have been:
"$A$2:$AQ$"
or even:
"A2:AQ"

You're using a VisibleCells line twice: once on the whole table and once on column N. You only need do it on column N, and check that that is Not Nothing.

Application.DisplayAlerts = False isn't needed at all.

With lines like:
If Not rng Is Nothing Then rng = "=C2&"" - ""&A2&"" - ""&O2"
1. will only be referencing the right row IF the first cell to receive that formula is on row 2. That can easily be corrected by using FormulaR1C1 instead:
If Not rng Is Nothing Then rng.FormulaR1C1 = "=RC[-11] & "" - "" & TEXT(RC[-13],""d-mmm-yy"") & "" - "" & RC[1]"
You can get that code by recording a macro of you editing that formula, not changing it and pressing Enter.
2. Column A contains dates which in Excel are numbers (today is 43080), so you're seeing numbers instead of dates. That A2 needs to be TEXT(A2,"d-mmm-yy").

You don't need to Activate or Select anything, so I've taken that out too.

So your first code can be:
Code:
Sub ModificationCriteriaOSVV1()
Dim rng As Range
With Sheets("OSV_Vendor")
  If .AutoFilterMode Then .Cells.AutoFilter
  Rws = .Cells(.Rows.Count, "O").End(xlUp).Row
  .Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="Modification", Operator:=xlFilterValues
  On Error Resume Next
  Set rng = .Range(.Cells(2, "N"), .Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.FormulaR1C1 = "=RC[-11] & "" - "" & TEXT(RC[-13],""d-mmm-yy"") & "" - "" & RC[1]"
  .AutoFilterMode = False
End With
End Sub
and your second code:
Code:
Sub ModificationCriteriaOSVV2()
Dim rng As Range
With Sheets("OSV_Vendor")
  If .AutoFilterMode Then .Cells.AutoFilter
  Rws = .Cells(.Rows.Count, "O").End(xlUp).Row
  .Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="New creation", Operator:=xlFilterValues
  On Error Resume Next
  Set rng = .Range(.Cells(2, "N"), .Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.FormulaR1C1 = "=RC[-11] & "" - "" & TEXT(RC[-13],""d-mmm-yy"") & "" - "" & RC[-8] & "" - "" & RC[1]"
  .AutoFilterMode = False
End With
End Sub

You could roll both codes into one:
Code:
Sub ModificationCriteriaOSVV_1and2()
Dim rng As Range
With Sheets("OSV_Vendor")
  If .AutoFilterMode Then .Cells.AutoFilter
  Rws = .Cells(.Rows.Count, "O").End(xlUp).Row

  .Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="Modification", Operator:=xlFilterValues
  On Error Resume Next
  Set rng = .Range(.Cells(2, "N"), .Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.FormulaR1C1 = "=RC[-11] & "" - "" & TEXT(RC[-13],""d-mmm-yy"") & "" - "" & RC[1]"

  .Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="New creation", Operator:=xlFilterValues
  Set rng = Nothing
  On Error Resume Next
  Set rng = .Range(.Cells(2, "N"), .Cells(Rws, "N")).SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.FormulaR1C1 = "=RC[-11] & "" - "" & TEXT(RC[-13],""d-mmm-yy"") & "" - "" & RC[-8] & "" - "" & RC[1]"

  .AutoFilterMode = False
End With
End Sub

Now, just which cell or cells do you want a border around and Arial 10?
(Attach another file to show us what you want regarding this.)
 
Last edited:
Thank so much! It really helped! Both together in one coding really paid the price in the my list!

After I prepare the list, I need to insert border for all the available data with Font Arial 10. Doesn't it UsedRange work here?
 
Usedrange is possible, depends what you want to affect, just the table or everything else as well.
Code:
With Range("A1").CurrentRegion
  .Borders.LineStyle = xlContinuous
  With .Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 10
    .ColorIndex = xlAutomatic
  End With
End With
 
Thank you so much! it helps a lot.

Sorry to come again. I have a huge set of data and the deletion is always taking time and after run the below code and file size become huge . The formula gets applied in the entire workbook and cell clear also does not help me. Do you have a better code to filter and delete (without header) and skip if no values found.

Code1:

Code:
Range("A1").Select
    Rws = Cells(Rows.Count, "O").End(xlUp).Row

    ActiveSheet.Range("$A$1:$AO$" & Rws).AutoFilter Field:=15, Criteria1:="<>New creation", Operator:=xlAnd, Criteria2:="<>Modification"
    Set Rng = Range(Cells(2, "O"), Cells(Rws, "O")).SpecialCells(xlCellTypeVisible).Delete
    Application.CutCopyMode = False

Code2:

Code:
Sub DeleteCheckUser2()

Sheets("PC1_Vendor").Activate
On Error GoTo Line10:
        Rows("1:1").Select: Selection.AutoFilter: Selection.AutoFilter Field:=17, Criteria1:="Non-MasterData - Check_User" _
        , Operator:=xlFilterValues

        With ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
        End With
Line10:
    With ActiveSheet
    .AutoFilterMode = False
    End With

End Sub
 
Last edited by a moderator:
the line:
Code:
Set Rng = Range(Cells(2, "O"), Cells(Rws, "O")).SpecialCells(xlCellTypeVisible).Delete
could either lose the Set Rng = bit or could be split into two:
Code:
Set Rng = Range(Cells(2, "O"), Cells(Rws, "O")).SpecialCells(xlCellTypeVisible)
Rng.Delete
but more importantly, the code seems only to delete cells from column O - shouldn't it be deleting entire rows?:
Code:
Set Rng = Range(Cells(2, "O"), Cells(Rws, "O")).SpecialCells(xlCellTypeVisible).EntireRow
Rng.Delete
also:
Code:
With ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
can be shortened to:
Code:
ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
or if you want to keep the With:
Code:
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
End With
 
Back
Top