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

 

[muhammad susanto]

ok Zot, thank you for your explanation..

 

[muhammad susanto]

hi Zot...i think i missing problem for like this

Book1
	A	B	C	D	E	F	G
1	No	Ref	name	Reg	core	Year	month
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	mika		excelent	2020	7
6	5	A2	budi			2020	7
7	6	A3	John	5	poor	2020	5
8	7	A4	John	4	bad	2020	5
9	8	B1	Frans
10	9	B3	Job
11	10	C4	Bob
12	11	F2	Jacl	5	wors	2020	6
Sheet1

after run macro

Book1
	A	B	C	D	E	F	G
15	No	Ref	name	Reg	core	Year	month
16	1	A	John	1	ok	2020	7
17	2	A	John	34	good	2020	7
18	3	A	John			2020	7
19	4	A1	mika		excelent	2020	7
20	5	A2	budi			2020	7
21	6	A3	John	5	poor	2020	5
22	7	A4	John	4	bad	2020	5
23	8	B1	Jacl	5	wors	2020	6
24	9	B3
25	10	C4
26	11	F2
Sheet1

criteria:
-in Col. C always/default contains name not allowed empty cell
- if in col D till to G is empty/blank cell, clear contains data in col C (C9 til C11) then move up data in below to fill above
please do not Delete Rows , i want just clear contains
- col A & B don't change anything
thanks before it.

 

[Zot]

Here is the modified code

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 Application.WorksheetFunction.CountA(wsSrc.Range("D" & n, "G" & n)) = 0 Then
            If RowsToDelete Is Nothing Then
                Set RowsToDelete = wsSrc.Range("C" & n, "G" & n)
            Else
                Set RowsToDelete = Application.Union(RowsToDelete, wsSrc.Range("C" & n, "G" & n))
            End If
        End If
    Next
    RowsToDelete.Delete xlUp

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

 

[muhammad susanto]

hi Zot, thank you so much!!! Nice.