Consulting

Results 1 to 17 of 17

Thread: VBA code for deleting "FALSE" functions

  1. #1
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location

    Question VBA code for deleting "FALSE" functions

    Hello I have been working on creating a Macro for work and have gotten decently deep into it. I have created several small macros that plan on adding to my master macro in the end. However right now I am stuck in the "deleting_not_true" macro where I am trying to delete anything in column S that comes back as False but I am not sure what the VBA code to achieve this would be? The best I can do is referencing a set range of cells after filtering the data for False, but that data will change once the new master data is added.

    My second question will have to do with Macro "Autofilling" which simply autofills down to a certain cell but I need to add in a variable for it autofill down to however much data could be in the table at that time since it will change depending on what is in the master data. I am not familiar with the VBA code to achieve these objectives.Mutual Fund Fees.xlsm

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Play around with these

    Sub Autofilling()
        Dim r As Range
        Dim iLastRow As Long
        
        With ActiveSheet
            iLastRow = .Range("N1").End(xlDown).Row
        
            Set r = .Range("Q2")
            r.AutoFill Destination:=r.Resize(iLastRow - 1, 1)
        
            Set r = .Range("R2")
            r.AutoFill Destination:=r.Resize(iLastRow - 1, 1)
        
            Set r = .Range("S2")
            r.AutoFill Destination:=r.Resize(iLastRow - 1, 1)
        End With
        
    End Sub
    Sub deleting_not_true()
        Dim r1 As Range, r2 As Range, r As Range
        Dim i As Long
        
        With ActiveSheet
            Set r1 = .Cells(1, 19)
            Set r2 = .Cells(ActiveSheet.Rows.Count, 19).End(xlUp)
            Set r = Range(r1, r2)
        
            'when deleting it's important to start at the bottom
            For i = r.Rows.Count To 2 Step -1
                If IsError(r.Cells(i, 1).Value) Then
                    .Rows(i).EntireRow.Delete
                ElseIf .Cells(i, 1).Value = False Then
                    .Rows(i).EntireRow.Delete
                End If
            Next i
        
            .Columns("Q:S").Delete Shift:=xlToLeft
        End With
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    I think you have a problem with the filtering in the Mutual_fund_fees macro;
    You would lose values >100 and <101 with this filtering:
    .AutoFilter Field:=14, Criteria1:="<=100"
    .AutoFilter Field:=14, Criteria1:=">=101", Operator:=xlAnd, Criteria2:="<=1000"

    Your sample data has no such values, as it happens.

    You will lose values >1000 and <1001 with this:
    .AutoFilter Field:=14, Criteria1:=">=101", Operator:=xlAnd, Criteria2:="<=1000"
    .AutoFilter Field:=14, Criteria1:=">=1001", Operator:=xlAnd, Criteria2:="<=3000"

    You have 2 such values: 1000.52 on row 2315 and 1000.11 or row 7423 which never appear on your newly created sheets.

    You might want to use filter criteria more like this (depending on exactly how you want to split the data):
     .AutoFilter Field:=14, Criteria1:="<=100"
     .AutoFilter Field:=14, Criteria1:=">100", Operator:=xlAnd, Criteria2:="<=1000"
     .AutoFilter Field:=14, Criteria1:=">1000", Operator:=xlAnd, Criteria2:="<=3000"
    Also it could be a bit more robust to use
    Set wsMaster = Sheets("Master")
    instead of:
    Set wsMaster = ActiveSheet
    in case the active sheet isn't the right sheet when you start your macro.

    As regards the three other macros which add the formula, autofill and delete rows, it's probably better to combine these three operations in one macro because you'll be using the usedrange of the sheet to determine where the formulae get put.
    Thus:
    Sub FormulaeAddandDeleteRows(sht)
    'find extent of data on the fees sheet and create formula refs to be used later:
    With Sheets("Fees")
      Set rngFees = Intersect(.UsedRange, .UsedRange.Offset(1)) 'databody - excludes headers.
    End With
    ColmAAddress = rngFees.Columns(1).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmCAddress = rngFees.Columns(3).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmDAddress = rngFees.Columns(4).Address(ReferenceStyle:=xlR1C1, external:=True)
    'find extent of data on the current sheet:
    With sht
      Set myRng = Intersect(.UsedRange, .UsedRange.Offset(1)) 'databody - excludes headers.
      'Column Q,R & S formulae insert (you could do all this in one column with a longer formula):
      Intersect(myRng.EntireRow, .Range("Q:Q")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmCAddress & ")"
      Intersect(myRng.EntireRow, .Range("R:R")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmDAddress & ")"
      Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]=0,RC[-1]=0)"
      'filter for FALSE:
      .UsedRange.AutoFilter Field:=19, Criteria1:="FALSE"
      On Error Resume Next
      myRng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
      On Error GoTo 0
      .ShowAllData
      '.Range("Q:S").Delete 'if you want.
    End With
    End Sub
    Call this at the bottom of the Mutual_fund_fees macro like this:
    For Each sht In Sheets(Array("100 and below", "101 to 1000", "1001 to 3000"))
      FormulaeAddandDeleteRows sht
    Next sht
    You may want to Dim sht as Worksheet at the top.

    It was difficult to test because you omitted column H values from the Master sheet. Perhaps attach a workbook with that data included?

    All that said, you could use Power Query to do all this processing. I'll prepare something with that tomorrow sometime (for which a new attachment from you would be welcome).
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Sub M_snb()
        Range("Q2:S2").AutoFill Range("Q2:S2").Resize(Cells(1).CurrentRegion.Rows.Count - 1)
    End Sub
    If S2 ='TRUE"

    Sub M_snb()
        Rows(1).Copy
        Columns(19).ColumnDifferences(Cells(2, 19)).EntireRow.Delete
        Rows(1).Insert
    End Sub

  5. #5
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    Thanks for the help with the first Macro I had not thought of that when looking over it.
    In terms of the extra data i can give you to test it I can upload another file with some dummy security numbers that should help for any testing that you may need.
    Attached Files Attached Files

  6. #6
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    In the attached, which has column H populated with your most recent attachment's dummy security nos., run your macro to add the 3 new sheets.
    To update the sheets with the Power Queries in (the tab names all start PQ…) either right-click on each table individually and choose Refresh, or, refresh all at once by going to the Data tab of the ribbon, and clicking Refresh all in the Queries & Connections section.
    I get the same sets of results in Power Query as your macro gets.
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  7. #7
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    I'm getting an error 424 in the code here when trying to run any idea why? it worked before so I'm not sure what's wrong


    'copy overWith rData
    .AutoFilter Field:=14, Criteria1:="<=100"
    .SpecialCells(xlCellTypeVisible).Copy Worksheets("100 and below").Cells(1, 1)

    .AutoFilter Field:=14, Criteria1:=">100", Operator:=xlAnd, Criteria2:="<=1000"
    '.AutoFilter Field:=14, Criteria1:=">=101", Operator:=xlAnd, Criteria2:="<=1000"
    .SpecialCells(xlCellTypeVisible).Copy Worksheets("101 to 1000").Cells(1, 1)
    Last edited by BigBill7; 03-09-2021 at 11:57 AM.

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    1. Does the attachment in msg#6 work without error?
    2. You are starting this macro with the active sheet being the Master sheet? (If a blank sheet is the active sheet you will get this error). My earlier comment:
    Also it could be a bit more robust to use
    Set wsMaster = Sheets("Master")
    instead of:
    Set wsMaster = ActiveSheet
    would be important here.
    3. I need to see at least your whole code for this macro (preferably the workbook it's failing on).
    4. What's changed?
    5. In your last message you quote code as:
    'copy overWith rData
    In your actual code these are on separate lines as in:
    'copy over
    With rData
    Yes?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    1: No the macro does not run without error

    2: the error occurs in the .AutoFilter Field:=14, Criteria1:="<=100" part of the code
    'Option Explicit

    Sub Mutual_fund_fees()
    Dim wsMaster As Worksheet
    Dim rData As Range

    Application.ScreenUpdating = False

    'set Master - assumed to be active sheet
    Set wsMaster = ActiveSheet
    Set rData = wsMaster.Cells(1, 1).CurrentRegion
    If wsMaster.AutoFilterMode Then wsMaster.AutoFilterMode = False

    'delete old ones
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("100 and below").Delete
    Worksheets("101 to 1000").Delete
    Worksheets("1001 to 3000").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0


    'add new ones
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "100 and below"
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "101 to 1000"
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "1001 to 3000"


    'copy over
    With rData
    .AutoFilter Field:=14, Criteria1:="<=100"
    .SpecialCells(xlCellTypeVisible).Copy Worksheets("100 and below").Cells(1, 1)

    .AutoFilter Field:=14, Criteria1:=">100", Operator:=xlAnd, Criteria2:="<=1000"
    '.AutoFilter Field:=14, Criteria1:=">=101", Operator:=xlAnd, Criteria2:="<=1000"
    .SpecialCells(xlCellTypeVisible).Copy Worksheets("101 to 1000").Cells(1, 1)



    .AutoFilter Field:=14, Criteria1:=">1000", Operator:=xlAnd, Criteria2:="<=3000"
    '.AutoFilter Field:=14, Criteria1:=">=1001", Operator:=xlAnd, Criteria2:="<=3000"
    .SpecialCells(xlCellTypeVisible).Copy Worksheets("1001 to 3000").Cells(1, 1)
    End With



    If wsMaster.AutoFilterMode Then wsMaster.AutoFilterMode = False

    'format
    Call FormatSheet("100 and below")
    Call FormatSheet("101 to 1000")
    Call FormatSheet("1001 to 3000")


    For Each sht In Sheets(Array("100 and below", "101 to 1000", "1001 to 3000"))
    FormulaeAddandDeleteRows sht
    Next sht


    wsMaster.Select

    Application.ScreenUpdating = True
    End Sub
    Private Sub FormatSheet(s As String)
    With Worksheets(s)
    .Select
    With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
    End With

    .Cells(1, 1).CurrentRegion.Columns.ColumnWidth = 100
    .Cells(1, 1).CurrentRegion.Columns.AutoFit
    End With
    End Sub


    Sub FormulaeAddandDeleteRows(sht)
    'find extent of data on the fees sheet and create formula refs to be used later:
    With Sheets("Fees")
    Set rngFees = Intersect(.UsedRange, .UsedRange.Offset(1)) 'databody - excludes headers.
    End With
    ColmAAddress = rngFees.Columns(1).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmCAddress = rngFees.Columns(3).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmDAddress = rngFees.Columns(4).Address(ReferenceStyle:=xlR1C1, external:=True)
    'find extent of data on the current sheet:
    With sht
    Set myRng = Intersect(.UsedRange, .UsedRange.Offset(1)) 'databody - excludes headers.
    'Column Q,R & S formulae insert (you could do all this in one column with a longer formula):
    Intersect(myRng.EntireRow, .Range("Q:Q")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmCAddress & ")"
    Intersect(myRng.EntireRow, .Range("R:R")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmDAddress & ")"
    Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]=0,RC[-1]=0)"
    'filter for FALSE:
    .UsedRange.AutoFilter Field:=19, Criteria1:="FALSE"
    On Error Resume Next
    myRng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    .ShowAllData
    '.Range("Q:S").Delete 'if you want.
    End With
    End Sub

    3: I don't believe anything has changed I opened the file attempted to F8 through the Macro to watch it
    4: yes i think i copied it wrong so i tried a new way and took out any source formatting

  10. #10

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    If the file I attached doesn't run properly, when it's run 'out of the box' when the Master sheet is the active sheet (it's fine here) Then what version of Excel are you using and is it on a Mac or a PC?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    ok I don't think I had the "Master" tab as the active sheet in the beginning. What is some code I cold add to Have the macro start on master sheet?

  13. #13
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    3rd time lucky:
    Quote Originally Posted by p45cal View Post
    Also it could be a bit more robust to use
    Set wsMaster = Sheets("Master")
    instead of:
    Set wsMaster = ActiveSheet
    in case the active sheet isn't the right sheet when you start your macro.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  14. #14
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    Sorry snb been working with alot of code lately see what works best, this also helps me I'll let you know if i have any further questions on your code or what is part of my next steps.

  15. #15
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    Thank you for the help so far I really appreciate it!
    For the next part of this project I'm working was one of the equations that was used in the "0 to 100" tab needs to be changed slightly for "101 to 1000" and "1001 to 3000"

    all I need to change is this part of the code for these different tabs
    Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]=0,RC[-1]=0)"

    "101 to 1000"
    Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]>0,RC[-1]=0)"

    "1001 to 3000"
    Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]>0,RC[-1]>0)"

    I know your code is dependent on going back and doing the same thing in each sheet so I'm not sure how to code it correctly to do what I need.

  16. #16
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Sub FormulaeAddandDeleteRows(sht)
    'find extent of data on the fees sheet and create formula refs to be used later:
    With Sheets("Fees")
      Set rngFees = Intersect(.UsedRange, .UsedRange.Offset(1))    'databody - excludes headers.
    End With
    ColmAAddress = rngFees.Columns(1).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmCAddress = rngFees.Columns(3).Address(ReferenceStyle:=xlR1C1, external:=True)
    ColmDAddress = rngFees.Columns(4).Address(ReferenceStyle:=xlR1C1, external:=True)
    'find extent of data on the current sheet:
    With sht
      Set myRng = Intersect(.UsedRange, .UsedRange.Offset(1))    'databody - excludes headers.
      'Column Q,R & S formulae insert (you could do all this in one column with a longer formula):
      Intersect(myRng.EntireRow, .Range("Q:Q")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmCAddress & ")"
      Intersect(myRng.EntireRow, .Range("R:R")).FormulaR1C1 = "=XLOOKUP(RC8," & ColmAAddress & "," & ColmDAddress & ")"
      Select Case sht.Name
        Case "101 to 1000"
          Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]>0,RC[-1]=0)"
        Case "1001 to 3000"
          Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]>0,RC[-1]>0)"
        Case Else
          Intersect(myRng.EntireRow, .Range("S:S")).FormulaR1C1 = "=AND(RC[-2]=0,RC[-1]=0)"
      End Select
      
      'filter for FALSE:
      .UsedRange.AutoFilter Field:=19, Criteria1:="FALSE"
      On Error Resume Next
      myRng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
      On Error GoTo 0
      .ShowAllData
      '.Range("Q:S").Delete 'if you want.
    End With
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  17. #17
    VBAX Regular
    Joined
    Feb 2021
    Posts
    18
    Location
    thank you for the help everyone I will change the thread to solved.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •