Select and delete contents below diagonal of cell array

[Jooles]

Hi All,

Within this forum I found code produced by Paul which selects a diagonal range of cells (see http://www.excelforum.com/excel-gene...nal-range.html ). I wish to select all the cells below the diagonal and also delete them. I thought of one way - but I don't know how to code it - from each diagonal do a Range(Selection, Selection.End(xlDown)).Select then delete, and repeat to the end of the diagonal, but this may be too inefficient or whatever..

Hoping there's a friendly E god out there.

[kalak]

If your (square array) is 6x6 staring from A1, then maybe this.
It deletes the below diagonal but doesn't select.
Do you really want to select? If so, why? Selecting isn't usually useful.

Sub below_diag()
Const n As Long = 6
With Range("A1").Resize(n, n)
    a = .Value
    For i = 1 To n
        For j = 1 To i - 1
             a(i, j) = vbNullString
        Next j
    Next i
Range("A1").Resize(n, n) = a
End With
End Sub

[Jooles]

Thank you very much for the quick response. You are correct I will not need to select the cells if the contents are just deleted. In addition it would be good to have the diagonal start from the current active cell if that is possible. I have tried a few things but its like trying to learn Russian and I am not very good at Russian. I have several large arrays of formulas that require this to be done and that would save me editing the macro each time.
Thanks again and Best regards.

[kalak]

to start from active cell, try the below
the size of the relevant array (6X6, where n=6) is at the top of the code but you can change this as you like

Sub below_diag2()
Const n As Long = 6
With ActiveCell.Resize(n, n)
    a = .Value
    For i = 1 To n
        For j = 1 To i - 1
             a(i, j) = vbNullString
        Next j
    Next i
    .Value = a
End With
End Sub

[Jooles]

Wow, that works perfectly.
Thank you

[Jooles]

Further investigation reveals that every cell within the column and row "box" defined by the "n" sized diagonal is affected. That is the columns above the diagonal have their formulas converted to "0", and the ones below are cleared completely. The rows and columns outside this diagonal defined box +1 cell, maintain their formulas intact.

[kalak]

perhaps try slight modification

Sub more_below_diag()
Const n As Long = 6
Dim i As Long, j As Long
With ActiveCell.Resize(n, n)
    For i = 1 To n
        For j = 1 To i - 1
             .Cells(i, j).ClearContents
        Next j
    Next i
End With
End Sub

[kalak]

or, if you like, you can use unions and select as you initially requested as well as deleting

Sub even_more_below_diag()
Const n As Long = 6
Dim i As Long, j As Long, u As Range
With ActiveCell.Resize(n, n)
    For i = 1 To n
        For j = 1 To i - 1
             If u Is Nothing Then
                Set u = .Cells(2, 1)
            Else
                Set u = Union(u, .Cells(i, j))
            End If
        Next j
    Next i
End With
u.ClearContents
u.Select
End Sub

[Jooles]

Hi Sorry, jumped the gun there. The macro clears all the lower left cells but also removes all formulas within the cells in the upper right above the diagonal too replacing them with just "0". Can the clearing of the lower left cells be done without affecting independent formulas in the remaining cells? Thanks again for your attention

[Jooles]

Thanks again for your efforts, sorry I haven't been able to test your new codes while waiting for my spreadsheet to finish its 23 hr run. Both your codes work perfectly but are too slow for me at ~4 cells per second, I have 19 millions cells that will take nearly a month to complete. What I will do is demonstrate more patience myself and use the diag. select tool to delete my way through them manually, it should only take a few hours. If you are still interested my plan is to work my way down the left column of cells and selecting a diag. that gets shorter by 1 cell each step.& deleting... until I can pick big enough squares to delete large chunks at a time.

[kalak]

hmm,
19 million cells involved, some with formulae.
this problem is getting more interesting
try this code
it allows for 4400x4400 (=19.36 million cells) but can change to whatever you like. took me about 1.4 secs for data without formulae starting from active cell A1, but haven't tested it with formulae

Sub diag2()

Dim n&, i&, u As Range, s As String, adr As String
n = 4400
Application.Calculation = xlManual
With ActiveCell.Resize(n, n)
    For i = 1 To n - 1
        adr = .Cells(i + 1, i).Resize(n - i).Address(0, 0)
        If Len(s & "," & adr) < 255 Then
            s = s & "," & adr
        Else
            .Range(Mid(s, 2)).ClearContents
            s = "," & adr
        End If
    Next i
If Len(s) > 0 Then .Range(Mid(s, 2)).ClearContents
End With
Application.Calculation = xlAutomatic

End Sub

[Jooles]

Tried it and it appears that nothing happens, I used n=4400 and then just n=10, it sat there processing for a couple of seconds and then...nothing.
Did I miss something? My formulas are 3 deep 'If' statements... nothing more than that but there are a lot of them, actually its not 19 million in one array but across 18 arrays, so its good that n is variable.
Thanks again for your attention.

[kalak]

It's hard to do much more without seeing an example of your data.
Can you post a sample file and try to be as specific as you can as to what you want done with it?

That last code I posted. It starts from the active cell as you requested, so you need to have a cell selected else it won't do anything.

I tested that code by filling a 4400x4400 range on a worksheet, selecting cell A1, and running the code.
All cells below the principal diagonal were deleted.

You can try for yourself. Like run the below testdata code on a blank sheet, making sure cell A1 is the active or selected cell. Then run my Post#11 code.

Doesn't it do just what you asked for? and fast enough?

Sub testdata()
With Range("A1")
    .Resize(4400, 4400) = "axa"
    .Select
End With
End Sub

[Jooles]

Hi kalak, I've discovered my mistake, see screen shot from my test sheet;
Testr_screenshot.jpg
The first array of 2's with active cell A1 works great, however as you move horizontally away from A1 the start of the diagonal is offset from the active cell by the same amount and of course when I tested it before my active cell was CQ so the deleted cells were way off screen....the formula for my array is "=IF($A6=0,0,IF($H6=$B$7,IF($D$7=4,$D$7,0),0))" copied across and down for 994 cells. Hope this helps.

[kalak]

I'm not sure what your problem is at this point, or indeed if you still have one.

I looked at your screen shot, but it wasn't enlightening.

The code in Post#11 does just as you requested in your thread title, and in subsequent posts.

The code below fills a 994x994 array with your formula. Then running the Post#11 code clears everything below the principal diagonal, as you requested. So, just what is the problem, or is there still a problem?

Sub formulafill()

Application.Calculation = xlManual

Cells(1).Resize(994, 994) = "=IF($A6=0,0,IF($H6=$B$7,IF($D$7=4,$D$7,0),0))"

Application.Calculation = xlAutomatic

End Sub

[Jooles]

Sorry for my poor explanation. I am not trying to be obscure. The code in post 11 doesn't work unless the active cell is A1. My screenshot is missing an explanation I wrote and omitted, if you look at the highlighted cell J1 you will see the array of cells all around are still there and this shot was taken just after I ran the code in post 11, you will notice the diagonal starts at an offset along the same row as J1 equal to the distance J1 is from A1. Otherwise it works fine. Hope this is clearer.

[kalak]

Jooles,

OK. That was an oversight error by me. Sorry about that.
In this line of the Post#11 code

If Len(s) > 0 Then .Range(Mid(s, 2)).ClearContents

just delete the period (i.e. fullstop or point) immediately before Range.

[Jooles]

Thanks Kalak, After also deleting the dot before range here ( .Range(Mid(s, 2)).ClearContents ) your code from post #11 works very well. It is quick, precise and from the active cell. This has solved my issue.
Best Regards and thanks for your efforts,

Jooles