Consulting

Page 3 of 4 FirstFirst 1 2 3 4 LastLast
Results 41 to 60 of 63

Thread: Selecting and deleting rows based on criteria

  1. #41
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by snb View Post
    I still think this is sufficient for range starting in row 13:

    Sub M_snb()
        For Each sh In Sheets
            sh.UsedRange.Columns(1).Offset(12).SpecialCells(4).EntireRow.Delete
            sh.Rows(11).SpecialCells(4).EntireColumn.Delete
        Next
    End Sub
    i certainly agree with you.

    but when it comes to process third party data it may become hell on earth.

    last week i was asked to consolidate about 500 email attachments. the files contained web imported data and were emailed by a third party on a daily basis for 2 years. the files had 3 rows of headers with merged rows and columns. many third row headers repeated more than once (under different merged areas). some files had blank row(s) at top, some had blank columns at left. column numbers did not match and changed over time.

    if the table structures of the files were the same it would take a few minutes to complete the requirement. i even did not need to write a procedure for that.


    i think this is the similar case for this thread.




    i think i can adopt your code for workbooks with static First Rows.

    user again will select a cell and that cell's row number will be used to offset the used range to selected cell's row.


    maybe (user first clicks YES button in MsgBox and selects a cell from row 13 for all worksheets in the workbook):
    Sub M_snb()
    
    
        Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
        For Each sh In Sheets
            sh.UsedRange.Columns(1).Offset(fRange.Row - 1).SpecialCells(4).EntireRow.Delete
            sh.Rows(fRange.Row - 2).SpecialCells(4).EntireColumn.Delete
            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW")
                sh.UsedRange.Offset(fRange.Row - 1).Replace it, "=12/0", xlWhole
            Next
            sh.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
        Next
    
    End Sub
    Last edited by mancubus; 01-27-2014 at 03:27 PM.
    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. #42
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by mancubus View Post
    hi.try this with copies of your files. not tested.pls keep in mind that Last Row of range to be processed is determined by the word "Source
    perhaps adding an error handling line such as On Error Resume Next will help handle errors which will be thrown by FIND method when there is not a match in the worksheet with the searched value. ----- i would put it before Do While fName "" line. ----- since it will suppress all error messages inserting it after all tests are completed is a good idea. we should detect the errors first and then handle them.
    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)

  3. #43
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    If its row is deleted the fRange becomes nothing. and the fRange.Row statement will throw an error. So storing its row number in a variable will handle this.



    Sub M_snb()
    
    
        Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
    FR = fRange.Row
        For Each sh In Sheets
            sh.UsedRange.Columns(1).Offset(FR - 1).SpecialCells(4).EntireRow.Delete
            sh.Rows(FR).SpecialCells(4).EntireColumn.Delete
            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW")
                sh.UsedRange.Offset(FR - 1).Replace it, "=12/0", xlWhole
            Next
            sh.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
        Next
    
    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)

  4. #44
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,641
    As far as I can see "NE,NW etc will be removed from the posted examples using the ....specialcells(4).entirerow.delete line

    Sub M_snb() 
        y= Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8).row
    
        For Each sh In Sheets 
            sh.UsedRange.Columns(1).Offset(y - 1).SpecialCells(4).EntireRow.Delete 
            sh.Rows(y).SpecialCells(4).EntireColumn.Delete 
        Next 
    End Sub

  5. #45
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by snb View Post
    As far as I can see "NE,NW etc will be removed from the posted examples using the ....specialcells(4).entirerow.delete line
    Sub M_snb()     y= Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8).row    For Each sh In Sheets         sh.UsedRange.Columns(1).Offset(y - 1).SpecialCells(4).EntireRow.Delete         sh.Rows(y).SpecialCells(4).EntireColumn.Delete     Next End Sub
    yep that's true for the sample file. i took into account the OP's amended requirement here:
    Quote Originally Posted by Beatrix View Post
    Hi mancubus. I missed this bit. That string criteria, does it need to be in the same column in all ws?? I've thought it might be anywhere within the range and it would be still ok . I guess that's too much to expect That's why Table 11-12-13-18-19 still have that specific rows
    is there a neater way to modify the final code you posted to cover that reqirement?
    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)

  6. #46
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    It's giving run-time error '1004': No cells were found

    It takes to below line when I debug.

    HTML Code:
     delRng.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete

    I've only changed this bit as it should be "LL" instead of single "L".

    HTML Code:
    For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW")
    It does the job for first ws but when it skips to next tab, it stops and can't find the cells

    Quote Originally Posted by mancubus View Post
    hi.
    try this with copies of your files. not tested.
    pls keep in mind that Last Row of range to be processed is determined by the word "Source".

    Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder()
    'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
    
    
        Dim wb As Workbook, ws As Worksheet
        Dim fRange As Range, delRng As Range
        Dim FirstRowQ As Variant
        Dim i As Long, FR As Long, LR As Long, LC As Long
        Dim fName, fPath As String
        
        fPath = "C:\Files\" 'change to suit. include final \
        'fPath = "C:\Users\Attila\test\beax\" 'change to suit. include final \
        
        fName = Dir(fPath & "*.xls*")
        'Dir function returns a string representing the first file in the specified folder.
        'using it without any arguments returns the next file: fName = Dir()
        
        Do While fName <> "" 'start loop
            
            Set wb = Workbooks.Open(fPath & fName)
            'open the file. assign it to wb variable
            
            For i = 1 To wb.Worksheets.Count
            'if here are any hidden sheets, select the first visible worksheet.
                If Worksheets(i).Visible Then
                    Worksheets(i).Select
                    Exit For 'when the first visible worksheet is selected exit loop.
                End If
            Next i
            
            FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
            'offer user 2 choices (YES, NO) to base the fist row selection method and another (CANCEL) to stop the code execution.
            
            If FirstRowQ = vbYes Then
            'user clicked the YES button. the row of selected cell in the next step will be used as First Row in all worksheets.
                
                Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
                'make user select the cell whose row number will be used as first row in all worksheets
                
                FR = fRange.Row
                'assign selected cell's row number to FR variable
                
                For Each ws In wb.Worksheets
                'loop all worksheets in the opened workbook
                    
                    With ws
                        If .Visible = True Then
                        'check if worksheet is visible. if visible continue next line.
                            
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                            'find the first occurence of string "Source" from bottom-up. return its row number. -1 means 1 row above Source will be Last Row
                            
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                            'find the first occurence of any string/value from right-left. return its column number as Last Column.
                            
                            Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
                            'set the range to delete rows and columns based on condition usng the variables determined above: FR,LR, and LC. 1 is for column A.
                            
                            delRng.Columns(1).SpecialCells(4).EntireRow.Delete
                            'determine the blank cells in the first column of the set range and delete their rows.
                            
                            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW")
                                delRng.Cells.Replace it, "=12/0", xlWhole
                            Next
                            'loop all cells in the range for all string criteria and if found a match change it to "=12/0" formula to display a formula error in cell.
                            'it may be "=15/0" or "=0/0", whatever. this is done to use specialcells method to get all cells with formula errors.
                            
                            delRng.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
                            'or =
                            'delRng.SpecialCells(-4123, 16).EntireRow.Delete
                            'any of the above lines will delete the rows that contain a formula error.
                            
                            .Rows(FR).SpecialCells(4).EntireColumn.Delete
                            'determine the blank cells in the first row of the set range and delete their columns.
                        End If
                    End With
                
                Next ws
            
            ElseIf FirstRowQ = vbNo Then
            'user clicked the NO button. the row of selected cell in each worksheet will be used as First Row in each woksheets separately.
    
    
                For Each ws In wb.Worksheets
                    With ws
                        If .Visible = True Then
                            .Activate 'in order to select a range in a worksheet that sheet must be selected first.
                            Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
                            FR = fRange.Row
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                            Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
                            delRng.Columns(1).SpecialCells(4).EntireRow.Delete
                            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW")
                                delRng.Cells.Replace it, "=12/0", xlWhole
                            Next
                            .Rows(FR).SpecialCells(4).EntireColumn.Delete
                        End If
                    End With
                Next ws
            
            Else
            'user clicked the CANCEL button.
                
                MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
                'inform the user about cancellation.
                
                wb.Close SaveChanges:=False
                'close the first workbook without saving.
                
                Exit Sub
                'exit procedure.
            End If
            
            wb.Close SaveChanges:=True
            'save and close the workbook whose rows and columns are deleted
            fName = Dir()
            'return the next file
        
        Loop
        'go back to Do While fName <> "" line to process the next workbook.
    
    
    End Sub
    Sub Learning VBA()

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

    End Sub

  7. #47
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,641
    As long as the OP uses merged cells, it's useless to invent a VBA approach.
    As long as the sample files are not representative for the real ones, it's not possible to create a bullitproof approach (I have no idea what all the X's stand for).

  8. #48
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    1) it means delRng.SpecialCells(xlCellTypeFormulas, xlErrors) returns nothing. that's why i suggested inserting On Error Resume Next statement. sorry for not including it in the last procedure i posted. you may insert it before Do While... line. ----- 2) because of the error the code stops execution. please test the code with the workbook you uploaded here.
    Last edited by mancubus; 01-28-2014 at 06:29 AM.
    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)

  9. #49
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by snb View Post
    As long as the OP uses merged cells, it's useless to invent a VBA approach.As long as the sample files are not representative for the real ones, it's not possible to create a bullitproof approach (I have no idea what all the X's stand for).
    from the messages posted before... ----- there are workbooks of two different types: 1) First rows in all sheets are the same and 2) are not the same. ----- we leave the decision as to which workbook has static FR and which does not have. ----- the OP has 3 requirements: a) delete blank cells' rows in column A. b) delete blank cells' columns in (user selected) first row. c) delete the rows of the cells that match with any of string criteria in the used range. one condition: keep the footnotes below each table. ----- i assume X's are any data that dont need to be taken into account for the code. ----- Beatrix pls correct the wrong points, if any.
    Last edited by mancubus; 01-28-2014 at 06:27 AM.
    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)

  10. #50
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    Yes there are 2 different types of workbooks. 1- first row is same in all ws 2- first row is not same in all ws.
    Requriments are ;
    1- Delete blank rows and columns in range: first row (user selects) and the last row (determined by the word Source, your VBA approach was pretty good in this one mancubus)
    2- Delete entire row where the cells match with anything in string criteria in the range.


    Quote Originally Posted by mancubus View Post
    from the messages posted before... ----- there are workbooks of two different types: 1) First rows in all sheets are the same and 2) are not the same. ----- we leave the decision as to which workbook has static FR and which does not have. ----- the OP has 3 requirements: a) delete blank cells' rows in column A. b) delete blank cells' columns in (user selected) first row. c) delete the rows of the cells that match with any of string criteria in the used range. one condition for row delete: keep the footnotes below each table. ----- i assume X's are any data that dont need to be taken into account for the code. ----- Beatrix pls correct the wrong points, if any.
    Sub Learning VBA()

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

    End Sub

  11. #51
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    I guess that's why the OP's VBAX title is "Contributor" and yours is "Master" snb

    Quote Originally Posted by snb View Post
    As long as the OP uses merged cells, it's useless to invent a VBA approach.
    As long as the sample files are not representative for the real ones, it's not possible to create a bullitproof approach (I have no idea what all the X's stand for).
    Sub Learning VBA()

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

    End Sub

  12. #52
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Beatrix. ----- the last code i posted deletes rows of blank cells in Column A, and deletes columns of blank cells in the First Row and does not "Delete blank rows and columns in range" since range can be (assuming FR = 13 / LR = 180 / LC = 10) "A13:J180". if A20 is blank, row 20 will be deleted regardless of other cells being non blank in the same row. is E25 is a blank cell but A25 is not, row 25 will not be deleted because only Col A is taken into account for row deletion. ----- if bolded bit in your last post is what you need, the code does not work for you and must be modified.
    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)

  13. #53
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    Yes I need to delete blank rows and columns in range. In all tabs, entire row is blank so column A would be blank then I gues it would not be a problem..However I'lI got your point and will consider that hopefully I am not going to have any blank rows with data in column A.

    The latest code you posted did the job. However it keeps giving below message while processing each step.

    "Microsoft Excel cannot find any data to replace. Check if your search formatting and criteria are defined correctly. If you are sure that matching data exists in this workbook, it may be on a protected sheet. Excel cannot replace data on a protected worksheet."

    I've checked every single workshet including hidden ones..there is no worksheet protection..

    I added the error line and tested it on attached files. Any other suggestions??

    HTML Code:
    fName = Dir(fPath & "*.xls*")
         'Dir function returns a string representing the first file in the specified folder.
         'using it without any arguments returns the next file: fName = Dir()
         
        On Error Resume Next
        Do While fName <> "" 'start loop
             
            Set wb = Workbooks.Open(fPath & fName)
             'open the file. assign it to wb variable



    Quote Originally Posted by mancubus View Post
    Beatrix. ----- the last code i posted deletes rows of blank cells in Column A, and deletes columns of blank cells in the First Row and does not "Delete blank rows and columns in range" since range can be (assuming FR = 13 / LR = 180 / LC = 10) "A13:J180". if A20 is blank, row 20 will be deleted regardless of other cells being non blank in the same row. is E25 is a blank cell but A25 is not, row 25 will not be deleted because only Col A is taken into account for row deletion. ----- if bolded bit in your last post is what you need, the code does not work for you and must be modified.
    Sub Learning VBA()

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

    End Sub

  14. #54
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by Beatrix View Post
    I guess that's why the OP's VBAX title is "Contributor" and yours is "Master" snb
    i am against forum titles based on post counts. mine is master too just because my post count exceeds 1000. how can i be called master compared to real masters of excel like snb.
    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)

  15. #55
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    i'm sorry for that. can you please visit http://www.vbaexpress.com/forum/show...-amp-Copy-Data and find post 14. please copy-paste With Application ................ End With after variable declarations. and the same bit before End Sub to same places in your workbook. add Dim calc As Long to tour declarations.
    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)

  16. #56
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    Ok. I've done that too. Please see the latest below. Now the file is opened message box popped but can't select the first row as the workbook doesn't pop up. I saved the script into a blank workbook and run it from there. However the workbook which needs to be processed is open but minimized and it doesn't let me to maximize it It was working before..



    HTML Code:
    
    Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder()
         'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
         
         
        Dim wb As Workbook, ws As Worksheet
        Dim fRange As Range, delRng As Range
        Dim FirstRowQ As Variant
        Dim i As Long, FR As Long, LR As Long, LC As Long
        Dim fName, fPath As String
        Dim calc As Long
        
        
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
            .EnableEvents = False
            calc = .Calculation
            .Calculation = xlCalculationManual
        End With
         
        fPath = "C:\vba\" 'change to suit. include final \
         'fPath = "C:\vba\" 'change to suit. include final \
         
        fName = Dir(fPath & "*.xls*")
         'Dir function returns a string representing the first file in the specified folder.
         'using it without any arguments returns the next file: fName = Dir()
         
        On Error Resume Next
        Do While fName <> "" 'start loop
             
            Set wb = Workbooks.Open(fPath & fName)
             'open the file. assign it to wb variable
             
            For i = 1 To wb.Worksheets.Count
                 'if here are any hidden sheets, select the first visible worksheet.
                If Worksheets(i).Visible Then
                    Worksheets(i).Select
                    Exit For 'when the first visible worksheet is selected exit loop.
                End If
            Next i
             
            FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
             'offer user 2 choices (YES, NO) to base the fist row selection method and another (CANCEL) to stop the code execution.
             
            If FirstRowQ = vbYes Then
                 'user clicked the YES button. the row of selected cell in the next step will be used as First Row in all worksheets.
                 
                Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
                 'make user select the cell whose row number will be used as first row in all worksheets
                 
                FR = fRange.Row
                 'assign selected cell's row number to FR variable
                 
                For Each ws In wb.Worksheets
                     'loop all worksheets in the opened workbook
                     
                    With ws
                        If .Visible = True Then
                             'check if worksheet is visible. if visible continue next line.
                             
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                             'find the first occurence of string "Source" from bottom-up. return its row number. -1 means 1 row above Source will be Last Row
                             
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                             'find the first occurence of any string/value from right-left. return its column number as Last Column.
                             
                            Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
                             'set the range to delete rows and columns based on condition usng the variables determined above: FR,LR, and LC. 1 is for column A.
                             
                            delRng.Columns(1).SpecialCells(4).EntireRow.Delete
                             'determine the blank cells in the first column of the set range and delete their rows.
                             
                            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "LL", "IL", "OL", "SE", "SW")
                                delRng.Cells.Replace it, "=12/0", xlWhole
                            Next
                             'loop all cells in the range for all string criteria and if found a match change it to "=12/0" formula to display a formula error in cell.
                             'it may be "=15/0" or "=0/0", whatever. this is done to use specialcells method to get all cells with formula errors.
                             
                            delRng.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
                             'or =
                             'delRng.SpecialCells(-4123, 16).EntireRow.Delete
                             'any of the above lines will delete the rows that contain a formula error.
                             
                            .Rows(FR).SpecialCells(4).EntireColumn.Delete
                             'determine the blank cells in the first row of the set range and delete their columns.
                        End If
                    End With
                     
                Next ws
                 
            ElseIf FirstRowQ = vbNo Then
                 'user clicked the NO button. the row of selected cell in each worksheet will be used as First Row in each woksheets separately.
                 
                 
                For Each ws In wb.Worksheets
                    With ws
                        If .Visible = True Then
                            .Activate 'in order to select a range in a worksheet that sheet must be selected first.
                            Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
                            FR = fRange.Row
                            LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
                            LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                            Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
                            delRng.Columns(1).SpecialCells(4).EntireRow.Delete
                            For Each it In Array("NE", "NW", "YH", "EM", "WM", "E", "LL", "IL", "OL", "SE", "SW")
                                delRng.Cells.Replace it, "=12/0", xlWhole
                            Next
                            .Rows(FR).SpecialCells(4).EntireColumn.Delete
                        End If
                    End With
                Next ws
                 
            Else
                 'user clicked the CANCEL button.
                 
                MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
                 'inform the user about cancellation.
                 
                wb.Close SaveChanges:=False
                 'close the first workbook without saving.
                 
                Exit Sub
                 'exit procedure.
            End If
             
            wb.Close SaveChanges:=True
             'save and close the workbook whose rows and columns are deleted
            fName = Dir()
             'return the next file
             
        Loop
         'go back to Do While fName <> "" line to process the next workbook.
         
          With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = xlCalculationManual
        End With
         
    End Sub



    Quote Originally Posted by mancubus View Post
    i'm sorry for that. can you please visit http://www.vbaexpress.com/forum/show...-amp-Copy-Data and find post 14. please copy-paste With Application ................ End With after variable declarations. and the same bit before End Sub to same places in your workbook. add Dim calc As Long to tour declarations.
    Sub Learning VBA()

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

    End Sub

  17. #57
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    I will check it asap...

    First quit excel and reopen it. Delete screenupdating bit. Try previous codes.
    Last edited by mancubus; 01-28-2014 at 10:18 AM.
    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)

  18. #58
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Quote Originally Posted by Beatrix View Post
    Ok. I've done that too. Please see the latest below. Now the file is opened message box popped but can't select the first row as the workbook doesn't pop up. I saved the script into a blank workbook and run it from there. However the workbook which needs to be processed is open but minimized and it doesn't let me to maximize it It was working before..
    i hope below procedure will work for you. for the purposes of this code blank row/column means all cells in that row/column are blank.

    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\"
         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
                        End If
                    End With
                    .Rows.AutoFit
                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
                        End If
                        .Rows.AutoFit
                    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 = xlCalculationManual
        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)

  19. #59
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    i made too many mistakes for a single project. the third line from last would be: .Calculation = calc sorry
    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)

  20. #60
    VBAX Mentor
    Joined
    May 2010
    Location
    London
    Posts
    307
    Location
    Quote Originally Posted by mancubus View Post
    i made too many mistakes for a single project. the third line from last would be: .Calculation = calc sorry
    thanks mancubus. As you said 3rd line do I need to replace .AskToUpdateLinks = False bit with .Calculation = calc as below ??

    from:

    HTML Code:
    With Application 
            .DisplayAlerts = True 
            .EnableEvents = True 
            .AskToUpdateLinks = True 
            .Calculation = xlCalculationManual 
        End With
    to:

    HTML Code:
    With Application
            .DisplayAlerts = True
            .EnableEvents = True
            .Calculation = calc
            .Calculation = xlCalculationManual
                
        End With
    I also made the same correction for the with statement after variable declaration however it's giving a compile error message reads: Invalid or unqualified reference.
    I tested it without deleting .AskToUpdateLinks = False line too but same error. I was wondering if you had a chance to test it in yours??

    Cheers
    B.
    Sub Learning VBA()

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

    End Sub

Posting Permissions

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