• 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

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

  • Sample file.xls
    40 KB · Views: 2
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
 
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


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
 
Back
Top