• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Delete Row based on Cell Value not working

A

appu_gusai

Member
hi all

i have this code, this code is working for delete a cell, but not a delete entire row, i want to delete entire row .....

Code: 
    Dim intA As Integer
    Dim wrksht As Excel.Worksheet
With ActiveWorkbook.Worksheets("Stat")

Set wrksht = Application.Worksheets("Stat")
                intA = 8

              Do Until intA = Worksheets("Stat").UsedRange.Rows.Count
       
                Select Case wrksht.Cells(intA, "C").Value
                        Case "", "Vacant (GP: 6600)", "Vacant (GP: 5400)", "Vacant (GP: 4600)", "Vacant (GP: 4400)", "Vacant (GP: 4200)", "Vacant (GP: 2800)", "Vacant (GP: 2400)", "Vacant (GP: 1900)", "Vacant (GP: 1650)", "Vacant (GP: 1400)"
              wrksht.Rows(intA).EntireRow.Delete
           
            Case Else
              intA = intA + 1

        End Select
       
            Loop
End With


thank in advances :)
 
Your code seems ok meanwhile try this!!

Code: 
Dim intA As Integer

With Worksheets("Stat")
intA = 8
    Do Until intA = .UsedRange.Rows.Count
        Select Case .Cells(intA, "C").Value
            Case "", "Vacant (GP: 6600)", "Vacant (GP: 5400)", "Vacant (GP: 4600)", _
                "Vacant (GP: 4400)", "Vacant (GP: 4200)", "Vacant (GP: 2800)", "Vacant (GP: 2400)", _
                "Vacant (GP: 1900)", "Vacant (GP: 1650)", "Vacant (GP: 1400)"
                .Cells(intA, "C").EntireRow.Delete
                '.Rows(intA).EntireRow.Delete
            Case Else
                intA = intA + 1
        End Select
    Loop
End With
 
please find the attachment and therein the seen colored rows should be deleted with above said code............. presently these row are not deleted......
 

Attachments

It is losing focus when Excel inserts new workbook. You probably need to run through the code using step through code (F8 in VBE).

PS: I did not check the rest of the code. I have commented whatever I've addded.
Code: 
Private Sub CommandButton1_Click()
  Dim lastrowDB As Long, LastRow As Long
  Dim arr1, arr2, I As Integer
  Dim ShtsCnt As Integer
  Dim sCol, sRow As Long
  Dim intA As Integer
  Dim wrksht As Excel.Worksheet
  Dim wksSrc As Worksheet '// added a variable
   
  Set wksSrc = ActiveWorkbook.Worksheets("Sheet1") '// setting to main sheet
  With ActiveWorkbook.Worksheets("Sheet1")
  lastrowDB = .Cells(9, "A").End(xlUp).Row
  End With

  arr1 = Array("B", "O", "P")
  arr2 = Array("C", "E", "G")


  With Application
  ShtsCnt = .SheetsInNewWorkbook
  .SheetsInNewWorkbook = 2
  Workbooks.Add
  .SheetsInNewWorkbook = ShtsCnt
  .Worksheets("Sheet1").Name = "Form No. 27A"
  .Worksheets("Sheet2").Name = "Stat"
  End With

  For I = LBound(arr1) To UBound(arr1)
  With ThisWorkbook.Worksheets("Sheet1")
  LastRow = Application.Max(5, .Cells(.Rows.Count, arr1(I)).End(xlUp).Row)
  .Range(.Cells(5, arr1(I)), .Cells(LastRow, arr1(I))).Copy
  End With
   
  With ActiveWorkbook.Worksheets("Stat")
  .Range(arr2(I) & lastrowDB).Resize(LastRow - 4).PasteSpecial xlPasteValues
  End With
  With ActiveWorkbook.Worksheets("Stat")
  intA = 8
   
  With wksSrc 'with added here
  Do Until intA = .UsedRange.Rows.Count
  Select Case .Cells(intA, "B").Value
  Case "", "Vacant (GP: 6600)", "Vacant (GP: 5400)", "Vacant (GP: 4600)", _
  "Vacant (GP: 4400)", "Vacant (GP: 4200)", "Vacant (GP: 2800)", "Vacant (GP: 2400)", _
  "Vacant (GP: 1900)", "Vacant (GP: 1650)", "Vacant (GP: 1400)", "Vacant (GP: 1300)"
  .Cells(intA, "C").EntireRow.Delete
  .Rows(intA).EntireRow.Delete
  Case Else
  intA = intA + 1
  End Select
  Loop
  End With ' closing with
  End With
   
  Dim lookFor As Range
  Dim rng As Range
  Dim col As Integer
  Dim found As Variant

'  Set lookFor = ActiveWorkbook.Worksheets("Stat").Range("C8", ActiveWorkbook.Worksheets("Stat").Range("C65536").End(xlUp))
'  Set rng = ThisWorkbook.Worksheets("VLD").Columns("C:D")
  col = 2

  On Error Resume Next
  Next

  Application.CutCopyMode = False
End Sub
 
shrivallabha said:
It is losing focus when Excel inserts new workbook. You probably need to run through the code using step through code (F8 in VBE).

PS: I did not check the rest of the code. I have commented whatever I've addded.
Code: 
Private Sub CommandButton1_Click()
  Dim lastrowDB As Long, LastRow As Long
  Dim arr1, arr2, I As Integer
  Dim ShtsCnt As Integer
  Dim sCol, sRow As Long
  Dim intA As Integer
  Dim wrksht As Excel.Worksheet
  Dim wksSrc As Worksheet '// added a variable
  
  Set wksSrc = ActiveWorkbook.Worksheets("Sheet1") '// setting to main sheet
  With ActiveWorkbook.Worksheets("Sheet1")
  lastrowDB = .Cells(9, "A").End(xlUp).Row
  End With

  arr1 = Array("B", "O", "P")
  arr2 = Array("C", "E", "G")


  With Application
  ShtsCnt = .SheetsInNewWorkbook
  .SheetsInNewWorkbook = 2
  Workbooks.Add
  .SheetsInNewWorkbook = ShtsCnt
  .Worksheets("Sheet1").Name = "Form No. 27A"
  .Worksheets("Sheet2").Name = "Stat"
  End With

  For I = LBound(arr1) To UBound(arr1)
  With ThisWorkbook.Worksheets("Sheet1")
  LastRow = Application.Max(5, .Cells(.Rows.Count, arr1(I)).End(xlUp).Row)
  .Range(.Cells(5, arr1(I)), .Cells(LastRow, arr1(I))).Copy
  End With
  
  With ActiveWorkbook.Worksheets("Stat")
  .Range(arr2(I) & lastrowDB).Resize(LastRow - 4).PasteSpecial xlPasteValues
  End With
  With ActiveWorkbook.Worksheets("Stat")
  intA = 8
  
  With wksSrc 'with added here
  Do Until intA = .UsedRange.Rows.Count
  Select Case .Cells(intA, "B").Value
  Case "", "Vacant (GP: 6600)", "Vacant (GP: 5400)", "Vacant (GP: 4600)", _
  "Vacant (GP: 4400)", "Vacant (GP: 4200)", "Vacant (GP: 2800)", "Vacant (GP: 2400)", _
  "Vacant (GP: 1900)", "Vacant (GP: 1650)", "Vacant (GP: 1400)", "Vacant (GP: 1300)"
  .Cells(intA, "C").EntireRow.Delete
  .Rows(intA).EntireRow.Delete
  Case Else
  intA = intA + 1
  End Select
  Loop
  End With ' closing with
  End With
  
  Dim lookFor As Range
  Dim rng As Range
  Dim col As Integer
  Dim found As Variant

'  Set lookFor = ActiveWorkbook.Worksheets("Stat").Range("C8", ActiveWorkbook.Worksheets("Stat").Range("C65536").End(xlUp))
'  Set rng = ThisWorkbook.Worksheets("VLD").Columns("C:D")
  col = 2

  On Error Resume Next
  Next

  Application.CutCopyMode = False
End Sub
Click to expand...


hi BRO, sorry for i am late, your code is not working for me :(, any other code you have it?
 
Hi ,

If you want a problem resolved , please define the problem completely first.

Can you specify in plain English under what conditions you want a row deleted ?

Narayan
 
You must log in or register to reply here.
Back
Top