VBA ; Clear Content From C2 to E8 and Move up

[muhammad susanto]

hi all..
this code not fully working, how t o fix it to delete content with data up if there is blank row (above), and in col "name" automatic delete if data move up
this code:

Sub clearcontent()
    Dim lngLastRow As Long
    Dim wsSrc As Worksheet
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    Set wsSrc = ActiveSheet
    lngLastRow = wsSrc.Range("C:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    Dim RowsToDelete As Range
    ' Only delete the table area (If you know you have nothing to the right you could dispense
    ' with the intersect and just delete the entirerow)
    Set RowsToDelete = Intersect(wsSrc.Range("C2:E" & lngLastRow), _
                        wsSrc.Range("C2:A" & lngLastRow).SpecialCells(xlCellTypeBlanks).EntireRow)
    RowsToDelete.Delete Shift:=xlUp
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .CalculateFull
    End With
End Sub

this my table (before run macro):

Book1
	A	B	C	D	E	F	G
1	Ref	REF Verif	name	NOMOR REGISTER LELANG	REGISTER LELANG	Tahun Lelang	Bulan Lelang
2	1	A	John	1	ok	2020	7
3	2	A	John	34	good	2020	7
4	3	A	John			2020	7
5	4	A1	John		excelent	2020	7
6	5	A2	John			2020	7
7	6	A3	John	5	poor	2020	5
8	7	A4	John	4	bad	2020	5
Sheet1

expected result (after run macro)

Book1
	A	B	C	D	E	F	G
11	Ref	REF Verif	name	NOMOR REGISTER LELANG	REGISTER LELANG	Tahun Lelang	Bulan Lelang
12	1	A	John	1	ok	2020	7
13	2	A	John	34	good	2020	7
14	3	A	John		excelent	2020	7
15	4	A1	John	5	poor	2020	7
16	5	A2	John	4	bad	2020	7
17	6	A3				2020	5
18	7	A4				2020	5
Sheet1

thank in advance
susanto

 

[Zot]

I can't get the use of Intersect to work. Maybe it evaluated cell by cell. My method would be this

Sub clearcontent()
    Dim lngLastRow As Long, n As Long
    Dim wsSrc As Worksheet
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    Set wsSrc = ActiveSheet
    lngLastRow = wsSrc.Range("C:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    Dim RowsToDelete As Range
    For n = 2 To lngLastRow
        If IsEmpty(wsSrc.Range("D" & n)) And IsEmpty(Range("E" & n)) Then
            If RowsToDelete Is Nothing Then
                Set RowsToDelete = wsSrc.Range("C" & n, "E" & n)
            Else
                Set RowsToDelete = Application.Union(RowsToDelete, wsSrc.Range("C" & n, "E" & n))
            End If
        End If
    Next
    RowsToDelete.Delete xlUp

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .CalculateFull
    End With
End Sub

 

[muhammad susanto]

woow...Zot...Amazing!!!! thank you so much, working well..

 

[Zot]

woow...Zot...Amazing!!!! thank you so much, working well..

Glad could help

 

[muhammad susanto]

hi guys...i found new problem, actually my range in C2 to BU7130 to more fast running
i have modified that code with suitable change range
range c ---change C2
range e--- change BU7130

but the result is wrong show 400...
have you idea?

 

[Zot]

Can you post your whole new code (with modification)?

 

[muhammad susanto]

hi Zot...
like this

Sub clearcontent()
    Dim lngLastRow As Long, n As Long
    Dim wsSrc As Worksheet
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    Set wsSrc = ActiveSheet
    lngLastRow = wsSrc.Range("C:BU7130").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    Dim RowsToDelete As Range
    For n = 2 To lngLastRow
        If IsEmpty(wsSrc.Range("D" & n)) And IsEmpty(Range("BU7130" & n)) Then
            If RowsToDelete Is Nothing Then
                Set RowsToDelete = wsSrc.Range("C" & n, "BU7130" & n)
            Else
                Set RowsToDelete = Application.Union(RowsToDelete, wsSrc.Range("C" & n, "BU7130" & n))
            End If
        End If
    Next
    RowsToDelete.Delete xlUp

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .CalculateFull
    End With
End Sub

the core, for more faster clearing content ,i want to limited range only from cell C2 till BU7130

 

[Zot]

In the "BU7130" & n, the n represent the row number increment by For loop. So, you should put BU only like this "BU" & n.

In my original code
If IsEmpty(wsSrc.Range("D" & n)) And IsEmpty(Range("E" & n)) Then
I was checking if range D and range E is empty, the condition to meet before registering range C to E to be deleted at the end of the loop with this line
wsSrc.Range("C" & n, "E" & n)

In your code
If IsEmpty(wsSrc.Range("D" & n)) And IsEmpty(Range("BU7130" & n)) Then
it means the condition to meet is that Range Dx and Range BUx (x is row number) to be empty. I believe that is not what you wanted.

Then you mark range from C to BU to be deleted
wsSrc.Range("C" & n, "BU7130" & n)

What is the condition to meet actually?

 

[muhammad susanto]

actually, my range from C2 to BU7130, my problem when i use range wsSrc.Range("C" & n, "BU" & n), i feel very slow running

 

[Zot]

actually, my range from C2 to BU7130, my problem when i use range wsSrc.Range("C" & n, "BU" & n), i feel very slow running

The condition is still D and E empty? Your code is not like that.

It is a big row but the code is not deleting row as it progress but delete all at once at the end of the loop. This is as fast as it can go.