VBA macro to delete highlighted cells

[Yamasaki450]

Hello i need some help again.

I need macro to delete all red highlighted cells. My data goes from BE 1646 to MPT 3252. Cells are highlighted with conditional formatting if this matters...(see first screenshot)

And then i need to remove all blank cells and sort data in same order as before deleting highlighted cells (see second screenshot for example)

Or maybe there is another faster way to do this?

Thanks.

 

[Yamasaki450]

I give cells color in this way as member "awoohaw" suggested in bottom link in post 2. And then i sort data with VBA you gave me.
Is this possible to do with VBA or any other way to speed things up? It all works well just takes a while... Im a bit rusty in excel and not as good as others heh

Link:

Conditional formatting formula

Hey everyone i need some help with formulas. I need conditional formatting formula to highlight specific range of numbers in specific row. I would like to highlight all numbers from (-4 to 65) in rows where number 3 is in column C. So in this case all numbers from (-4 to 65) in range E4:T4 and...

www.mrexcel.com

 

[Cubist]

The conditional formatting seems unnecessary if you're just looking to delete cells with values between 4 and 65 inclusive.

 

[Yamasaki450]

The conditional formatting seems unnecessary if you're just looking to delete cells with values between 4 and 65 inclusive.

Actually i want to keep values between -4 and 65

 

[Cubist]

Remove the conditional formatting and try change

If r.Cells(i, j).DisplayFormat.Interior.Color <> RGB(255, 0, 0) Then

to

If a(i, j) >= -4 And a(i, j) <= 65 Then

Test on a copy.

 

[Yamasaki450]

Remove the conditional formatting and try change

If r.Cells(i, j).DisplayFormat.Interior.Color <> RGB(255, 0, 0) Then

to

If a(i, j) >= -4 And a(i, j) <= 65 Then

Test on a copy.

This works instant just 25 seconds nice. But it deletes values across whole range. What i need is to keep values between -4 and 65 just in rows where value 3 is in column C.
So in this case just row 6,10 and 15 (see screenshot)

Is this possible?

 

[Cubist]

The objective of this request isn't the same as the original post. Post a new thread.

 

[Yamasaki450]

The objective of this request isn't the same as the original post. Post a new thread.

True. I will do that. Thanks for your help guys.

 

[Yamasaki450]

This took just under 1 second for 20 columns, although it took 6.5 minutes for your full 14M+ cells - I'm working on making that faster. Please try on a copy of your workbook.

Option Explicit
Sub Delete_Red_Cells()
    Dim t As Double: t = Timer
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<-- *** Change sheet name to suit ***
    Dim r As Range
    Set r = ws.Range("BE1646").CurrentRegion
   
    Dim a, b
    a = r
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    Dim i As Long, j As Long, k As Long, LRow As Long, LCol As Long
    LRow = r.Rows.Count
    LCol = r.Columns.Count
    k = 1
    For j = 1 To LCol
        For i = 1 To LRow
            If r.Cells(i, j).DisplayFormat.Interior.Color <> RGB(255, 0, 0) Then
                b(k, j) = a(i, j)
                k = k + 1
            End If
        Next i
        k = 1
    Next j
    ws.Range("BE1646").Resize(LRow, LCol).Value = b
    MsgBox Timer - t
End Sub

Hey guys. Its me again heh

Can you help me modify this VBA so the data is sorted on bottom? So the same as question in first post just data sorted on bottom (see screenshot).

 

[kevin9999]

You really should start a new thread for this, however, try adding the following code after the line

ws.Range("BE1646").Resize(LRow, LCol).Value = b

New code:

Dim rng As Range
    Set rng = Range("BE1646").CurrentRegion
    LRow = rng.Rows.Count
    LCol = rng.Columns.Count
    k = 0
    For j = 1 To LCol
        For i = LRow To 1 Step -1
            If rng.Cells(i, j) = "" Then k = k + 1
        Next i
        If k > 0 Then Range(rng.Cells(1, j), rng.Cells(k, j)).Insert Shift:=xlDown
        k = 0
    Next j