Macro to delete rows based on cell values in a range - dynamic rows and columns

D

Dany46

New Member
Joined
Dec 2, 2020
Messages
8
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. MacOS
Hello team,

I would like to ask for help with the following macro as I just can't figure it out, I tried so many versions but nothing worked for me.

I need to remove all rows in my sheet that do not contain value greater than 50 in any cell in a given row. That means that if the value is less than 50 in all cells in a row but one, I need to keep this row and to only delete it if all the cells contain values that are less than 50 or are blank. However, my range is dynamic (both rows and columns are dynamic) which is causing the main issue for me as I don’t know how to specify the range correctly. The first three columns are text only, so I need the macro to only search for values from the fourth column until the last column and from the second row (the first one is header) until the last row. I need to “count” the number of rows based on the first column as it is the only column where no cell will ever be blank, e.g. this way: LastRow = Range("A" & Rows.Count).End(xlUp).Row

What would be of extra help but is not necessary – to change interior color of cells that are greater than 50 to RGB (255, 199, 206).

Thank you very much for any advice, it will be very appreciated!

Dany
 
Sort by date Sort by votes
You need to change code.
Here is improved version with both options.
VBA Code: 
Sub KeepGreaterRowsOrColumns()

    Dim varWS As Worksheet
    Dim varNRows As Long
    Dim varNColumns, varGreater As Integer
    Dim varRange1 As Range, varRange2 As Range, _
        varRange3 As Range, varRange4 As Range
    Dim varGreater2
    Dim varMsgBox As String
    
    Application.ScreenUpdating = False
    Set varWS = Worksheets("YourSheetName")
    varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
    varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
    
    varMsgBox = MsgBox("If you want to delete rows press button YES." & vbCrLf _
                     & "If you want to delete columns press button NO.", _
                        vbYesNoCancel, "DELETE ROWS OR COLUMNS")
                        
    If varMsgBox = vbYes Then
        Set varRange2 = varWS.Range("A2:A" & varNRows)
EX:
        For Each varRange1 In varRange2
            Set varRange3 = varWS.Range(Cells(varRange1.Row, 4), _
                Cells(varRange1.Row, varNColumns))
            varGreater = WorksheetFunction.CountIf(varRange3, ">50")
            For Each varRange4 In varRange3
                varGreater2 = varRange4.Value
                If varGreater2 > 50 Then varRange4.Interior.Color = RGB(255, 199, 206)
            Next
            If Not varGreater > 0 Then
                varWS.Rows(varRange1.Row).Delete
                GoTo EX
            End If
        Next
     End If
     
     If varMsgBox = vbNo Then
        Set varRange2 = varWS.Range _
            (Cells(1, 4), Cells(1, varNColumns))
EX2:
        For Each varRange1 In varRange2
            Set varRange3 = varWS.Range(Cells(2, varRange1.Column), _
                Cells(varNRows, varRange1.Column))
            varGreater = WorksheetFunction.CountIf(varRange3, ">50")
            For Each varRange4 In varRange3
                varGreater2 = varRange4.Value
                If varGreater2 > 50 Then varRange4.Interior.Color = RGB(255, 199, 206)
            Next
            If Not varGreater > 0 Then
                varWS.Columns(varRange1.Column).Delete
                GoTo EX2
            End If
        Next
     End If
     Application.ScreenUpdating = True
     
End Sub
 
Upvote 0

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
EXCEL MAX said:
You need to change code.
Here is improved version with both options.
VBA Code: 
Sub KeepGreaterRowsOrColumns()

    Dim varWS As Worksheet
    Dim varNRows As Long
    Dim varNColumns, varGreater As Integer
    Dim varRange1 As Range, varRange2 As Range, _
        varRange3 As Range, varRange4 As Range
    Dim varGreater2
    Dim varMsgBox As String
   
    Application.ScreenUpdating = False
    Set varWS = Worksheets("YourSheetName")
    varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
    varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
   
    varMsgBox = MsgBox("If you want to delete rows press button YES." & vbCrLf _
                     & "If you want to delete columns press button NO.", _
                        vbYesNoCancel, "DELETE ROWS OR COLUMNS")
                       
    If varMsgBox = vbYes Then
        Set varRange2 = varWS.Range("A2:A" & varNRows)
EX:
        For Each varRange1 In varRange2
            Set varRange3 = varWS.Range(Cells(varRange1.Row, 4), _
                Cells(varRange1.Row, varNColumns))
            varGreater = WorksheetFunction.CountIf(varRange3, ">50")
            For Each varRange4 In varRange3
                varGreater2 = varRange4.Value
                If varGreater2 > 50 Then varRange4.Interior.Color = RGB(255, 199, 206)
            Next
            If Not varGreater > 0 Then
                varWS.Rows(varRange1.Row).Delete
                GoTo EX
            End If
        Next
     End If
    
     If varMsgBox = vbNo Then
        Set varRange2 = varWS.Range _
            (Cells(1, 4), Cells(1, varNColumns))
EX2:
        For Each varRange1 In varRange2
            Set varRange3 = varWS.Range(Cells(2, varRange1.Column), _
                Cells(varNRows, varRange1.Column))
            varGreater = WorksheetFunction.CountIf(varRange3, ">50")
            For Each varRange4 In varRange3
                varGreater2 = varRange4.Value
                If varGreater2 > 50 Then varRange4.Interior.Color = RGB(255, 199, 206)
            Next
            If Not varGreater > 0 Then
                varWS.Columns(varRange1.Column).Delete
                GoTo EX2
            End If
        Next
     End If
     Application.ScreenUpdating = True
    
End Sub
Click to expand...
Thank you for the code. However, it seems the message box is giving me only one option - to either delete rows or columns, while what I need is to delete rows and then also columns. I guess there will be a second message box as well, but I am getting "Run-time error '13': Type mismatch" and it refers to this part of the code "If varGreater2 > 50 Then". Any thoughts on this, please?
 
Upvote 0
Dany46 said:
Thank you for the code. However, it seems the message box is giving me only one option - to either delete rows or columns, while what I need is to delete rows and then also columns. I guess there will be a second message box as well, but I am getting "Run-time error '13': Type mismatch" and it refers to this part of the code "If varGreater2 > 50 Then". Any thoughts on this, please?
Click to expand...
I noticed the declaration As Integer was missing, but it is still giving me the same error, but on "varGreater2 = varRange4.Value" now.
 
Upvote 0
Here is new united code that allows you to directly remove wanted rows and columns.
It's some kind of "sausage" code, but can run with longer data faster then previous versions,
because reducing range for search.
However, if you have sheet with big data be prepared to wait some time.
Test code from smaller to larger sheet data.
VBA Code: 
Option Explicit

Sub KeepGreaterRowsAndColumns()

    Dim varWS As Worksheet
    Dim varNRows As Long, varNColumns As Long, _
        varCurrentRow As Long, varCurrentColumn As Long
    Dim varGreater As Long
    Dim varRange1 As Range, varRange2 As Range, _
        varRange3 As Range, varRange4 As Range
    Dim varGreater2
   
    Application.ScreenUpdating = False
    Set varWS = Worksheets("YourSheetName")
    varCurrentRow = 2
    varCurrentColumn = 4
    varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
    varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
   
    Set varRange2 = varWS.Range("A" & varCurrentRow & ":A" & varNRows)
    Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
            Cells(varCurrentRow, varNColumns))
EX:
    For Each varRange1 In varRange2
        varGreater = WorksheetFunction.CountIf(varRange4, ">50")
        If Not varGreater > 0 Then
            varWS.Rows(varCurrentRow).Delete
            varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
            Set varRange2 = varWS.Range("A" & varCurrentRow & ":A" & varNRows)
            Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
                 Cells(varCurrentRow, varNColumns))
            If varCurrentRow > varNRows Then GoTo EX2
            GoTo EX
        End If
        For Each varRange3 In varRange4
            DoEvents
            varGreater2 = varRange3.Value
            If varGreater2 > 50 Then varRange3.Interior.Color = _
                RGB(255, 199, 206)
        Next
        varCurrentRow = varCurrentRow + 1
        Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
                Cells(varCurrentRow, varNColumns))
    Next

EX2:
    Set varRange2 = varWS.Range(Cells(1, varCurrentColumn), _
            Cells(1, varNColumns))
    Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
            Cells(varNRows, varCurrentColumn))
EX3:
    For Each varRange1 In varRange2
        varGreater = WorksheetFunction.CountIf(varRange4, ">50")
        If Not varGreater > 0 Then
            varWS.Columns(varCurrentColumn).Delete
            varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
            Set varRange2 = varWS.Range(Cells(1, varCurrentColumn), _
                Cells(1, varNColumns))
            Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
                 Cells(varNRows, varCurrentColumn))
            If varCurrentColumn > varNColumns Then GoTo EX4
            GoTo EX3
        End If
        For Each varRange3 In varRange4
            DoEvents
            varGreater2 = varRange3.Value
            If varGreater2 > 50 Then varRange3.Interior.Color = _
                RGB(255, 199, 206)
        Next
        varCurrentColumn = varCurrentColumn + 1
        Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
                Cells(varNRows, varCurrentColumn))
    Next
EX4:
    varWS.Range("A1").Activate
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
EXCEL MAX said:
Here is new united code that allows you to directly remove wanted rows and columns.
It's some kind of "sausage" code, but can run with longer data faster then previous versions,
because reducing range for search.
However, if you have sheet with big data be prepared to wait some time.
Test code from smaller to larger sheet data.
VBA Code: 
Option Explicit

Sub KeepGreaterRowsAndColumns()

    Dim varWS As Worksheet
    Dim varNRows As Long, varNColumns As Long, _
        varCurrentRow As Long, varCurrentColumn As Long
    Dim varGreater As Long
    Dim varRange1 As Range, varRange2 As Range, _
        varRange3 As Range, varRange4 As Range
    Dim varGreater2
  
    Application.ScreenUpdating = False
    Set varWS = Worksheets("YourSheetName")
    varCurrentRow = 2
    varCurrentColumn = 4
    varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
    varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
  
    Set varRange2 = varWS.Range("A" & varCurrentRow & ":A" & varNRows)
    Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
            Cells(varCurrentRow, varNColumns))
EX:
    For Each varRange1 In varRange2
        varGreater = WorksheetFunction.CountIf(varRange4, ">50")
        If Not varGreater > 0 Then
            varWS.Rows(varCurrentRow).Delete
            varNRows = varWS.Range("A" & Rows.Count).End(xlUp).Row
            Set varRange2 = varWS.Range("A" & varCurrentRow & ":A" & varNRows)
            Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
                 Cells(varCurrentRow, varNColumns))
            If varCurrentRow > varNRows Then GoTo EX2
            GoTo EX
        End If
        For Each varRange3 In varRange4
            DoEvents
            varGreater2 = varRange3.Value
            If varGreater2 > 50 Then varRange3.Interior.Color = _
                RGB(255, 199, 206)
        Next
        varCurrentRow = varCurrentRow + 1
        Set varRange4 = varWS.Range(Cells(varCurrentRow, 4), _
                Cells(varCurrentRow, varNColumns))
    Next

EX2:
    Set varRange2 = varWS.Range(Cells(1, varCurrentColumn), _
            Cells(1, varNColumns))
    Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
            Cells(varNRows, varCurrentColumn))
EX3:
    For Each varRange1 In varRange2
        varGreater = WorksheetFunction.CountIf(varRange4, ">50")
        If Not varGreater > 0 Then
            varWS.Columns(varCurrentColumn).Delete
            varNColumns = varWS.Cells(1, Columns.Count).End(xlToLeft).Column
            Set varRange2 = varWS.Range(Cells(1, varCurrentColumn), _
                Cells(1, varNColumns))
            Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
                 Cells(varNRows, varCurrentColumn))
            If varCurrentColumn > varNColumns Then GoTo EX4
            GoTo EX3
        End If
        For Each varRange3 In varRange4
            DoEvents
            varGreater2 = varRange3.Value
            If varGreater2 > 50 Then varRange3.Interior.Color = _
                RGB(255, 199, 206)
        Next
        varCurrentColumn = varCurrentColumn + 1
        Set varRange4 = varWS.Range(Cells(2, varCurrentColumn), _
                Cells(varNRows, varCurrentColumn))
    Next
EX4:
    varWS.Range("A1").Activate
    Application.ScreenUpdating = True
   
End Sub
Click to expand...
Thank you very much again, worked well and was pretty fast even for a large dataset. Also, I learned so much just from this problem and code!
 
Upvote 0
I'm glad that you think that code in not slow and works well.
It's nice if you were find some new stuffs through lines of code.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Delete row based on whether cell in alternate column in row has data
Replies
3
Views
85
LazyBug
LazyBug
C
  • Question
Delete Cell Range, or Add Range and Copy Formulas etc. - Excel VBA
Replies
0
Views
53
CSTjr
C
J
  • Solved
Limit Delete row and move xlUp to 1 column.
Replies
6
Views
64
Joe4
Joe4
M
  • Solved
Delete a row on value
Replies
3
Views
186
michellin
M
duteberta
  • Question
Add delete button in table column ONLY if condition is met.
2
Replies
10
Views
141
Anthony47
A

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top