PDA

View Full Version : delete the group cells



Nader
02-27-2008, 02:35 PM
take a look to pic please
I tried this code to clear only the Red cells according of the number of value 4 ,it's mean to stop delete at the cells blank, but it didn't succeed.


If Cells(Rows.Count, 1).Value = 4 Then
Cells(Rows.Count, 1).Value = ""
Cells(Rows.Count, 1).Offset(0, 1).Value = ""
If Cells.Value = "" Then Exit Sub 'to stop only to delete the red cells
End If

tstav
02-27-2008, 03:19 PM
First let me put in words what we are trying to do.
The following is what I have understood.
1.We are trying to locate a cell in column 1 that has the value of 4.
2.Once located, we clear this cell and all consecutive cells downwards until a blank cell is encountered.
Please correct any false assumptions I have made and I'll get back to you.
Regards

tstav
02-27-2008, 03:39 PM
Here is the code that complies with my previous post
Sub CommandButton1_Click()
Call ClearCells
End Sub

Sub ClearCells()
Dim mySheet As Worksheet
Dim lngRow, lngLastRow As Long
Set mySheet = ActiveWorkbook.Worksheets(1)
'Find the last Row in column 1
lngLastRow = mySheet.Cells(mySheet.Rows.Count, 1).End(xlUp).Row
'Locate a cell with value equal to 4
lngRow = 1
For lngRow = 1 To lngLastRow
If mySheet.Cells(lngRow, 1).Value = 4 Then
'Clear the cells until blank cell encountered
Do While mySheet.Cells(lngRow, 1).Value <> ""
mySheet.Cells(lngRow, 1).Value = ""
mySheet.Cells(lngRow, 1).Offset(0, 1).Value = ""
lngRow = lngRow + 1
Loop
Exit For
End If
Next
End Sub

Nader
02-28-2008, 11:27 AM
It wonderfull. Thank you

May you please help me to complete it. I want after delete the item. it will put the last data( by blue) on the place of red data(that deleted).
as it show.

tstav
02-28-2008, 12:01 PM
I'll get back to you in about two hours. Sorry, I'm not home right now.

Bob Phillips
02-28-2008, 01:10 PM
Sub ClearCells()
Dim mpSheet As Worksheet
Dim mpRow, mpLastRow As Long
Dim mpStart As Long
Dim mpEnd As Long

Set mpSheet = ActiveWorkbook.Worksheets(1)

mpLastRow = mpSheet.Cells(mpSheet.Rows.Count, 1).End(xlUp).Row

mpRow = 1
Do

If mpSheet.Cells(mpRow, 1).Value <> 4 Then mpRow = mpRow + 1
Loop Until mpSheet.Cells(mpRow, 1).Value = 4 Or mpRow > mpLastRow

If mpRow <= mpLastRow Then

mpStart = mpRow
Do

If mpSheet.Cells(mpRow, 1).Value <> "" Then mpRow = mpRow + 1
Loop Until mpSheet.Cells(mpRow, 1).Value = "" Or mpRow > mpLastRow

mpEnd = mpRow

mpSheet.Cells(mpStart, 1).Resize(mpEnd - mpStart + 1, 2).Delete shift:=xlShiftUp
End If
End Sub

tstav
02-28-2008, 02:15 PM
'No comments needed here
Set xld's_Answer = The_Work_Of_An_Expert(xld)

Greetings Nader!
Greetings xld!

Nader
02-28-2008, 05:21 PM
Thak you all and Greetings for all.
Xld may you please give me some explanation about the code like tstav.