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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.