Consulting

Page 4 of 4 FirstFirst ... 2 3 4
Results 61 to 63 of 63

Thread: Selecting and deleting rows based on criteria

  1. #61
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you are welcome.

    no that's not related with the settings.

    it seems there is an extra "End With" statement.

    below worked for me. i tested it with S1 workbook.

    Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder_Final_Revised()
         'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
         
        Dim wb As Workbook, ws As Worksheet
        Dim FirstRowQ As Variant
        Dim i As Long, FR As Long, LR As Long, LC As Long, calc As Long
        Dim fName As String, fPath As String
         
        With Application
            .DisplayAlerts = False
            .EnableEvents = False
            .AskToUpdateLinks = False
            calc = .Calculation
            .Calculation = xlCalculationManual
        End With
         
        fPath = "C:\Users\test\" 'change to suit. include final \
        fName = Dir(fPath & "*.xls*")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & fName)
            For i = 1 To wb.Worksheets.Count
                If Worksheets(i).Visible Then
                    Worksheets(i).Select
                    Exit For
                End If
            Next i
             
            FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
            If FirstRowQ = vbYes Then
                FR = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8).Row
                For Each ws In wb.Worksheets
                    With ws
                        On Error Resume Next
                        If .Visible = True Then
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                            For i = LR To FR Step -1
                                If Application.CountA(.Rows(i)) = 0 Then
                                    .Rows(i).Delete
                                Else
                                    For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "LL", "IL", "OL", "SE", "SW")
                                        If Application.CountIf(.Rows(i), it) > 0 Then .Rows(i).Delete
                                    Next
                                End If
                            Next
                            For i = LC To 1 Step -1
                                If Application.CountA(.Columns(i)) = 0 Then .Columns(i).Delete
                            Next
                            .Rows.AutoFit
                        End If
                    End With
                Next ws
            ElseIf FirstRowQ = vbNo Then
                For Each ws In wb.Worksheets
                    With ws
                        If .Visible = True Then
                            .Activate
                            FR = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8).Row
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                            For i = LR To FR Step -1
                                If Application.CountA(.Rows(i)) = 0 Then
                                    .Rows(i).Delete
                                Else
                                    For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "LL", "IL", "OL", "SE", "SW")
                                        If Application.CountIf(.Rows(i), it) > 0 Then .Rows(i).Delete
                                    Next
                                End If
                            Next
                            For i = LC To 1 Step -1
                                If Application.CountA(.Columns(i)) = 0 Then .Columns(i).Delete
                            Next
                            .Rows.AutoFit
                        End If
                    End With
                Next ws
            Else
                MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
                wb.Close SaveChanges:=False
                Exit Sub
            End If
             
            wb.Close SaveChanges:=True
            fName = Dir()
        Loop
         
        With Application
            .DisplayAlerts = True
            .EnableEvents = True
            .AskToUpdateLinks = True
            .Calculation = calc
        End With
         
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  2. #62
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    Quote Originally Posted by mancubus View Post
    you are welcome.

    no that's not related with the settings.

    it seems there is an extra "End With" statement.

    below worked for me. i tested it with S1 workbook.
    Brilliant! That's working..Thanks for your time and your help mancubus!

    Cheers
    B.
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

  3. #63
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you are welcome Beatrix. i'm glad it helped.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

Posting Permissions

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