Select Case and Delete rows

[labrooy]

I need some help fixing my errors. I am trying to automate a repetitive daily task.

At present, a vlookup is used in column J to return values from another sheet, then column J is used as the basis for further actions to be done.
For example, some rows are deleted based on the text shown in column J, and some cells in column I have the corresponding value in Column J pasted into them.

I want to perform both these tasks using a macro.

If it makes a difference - the values in column J are always vlookup formula results, rather than the text values which are shown in the sample file.

Sub del()
Dim lrow As Long
Dim xrow As Long
Dim i As Long
Dim y As Long

' Here I am trying to delete any row where column J has a text string starting with "Delete row -"
lrow = Cells(Rows.Count, "J").End(xlUp).Row
For xrow = lrow To 3 Step -1
    If Range("J" & xrow).Value = "Delete row-*" Then Rows(xrow).Delete
Next xrow

' Here I am trying to copy and paste from column J to column I , whenever the value in column J is between "CWA000000" To "CWA999999"
y = Cells(Rows.Count, "J").End(xlUp).Row
   For i = 2 To y
       Select Case Cells(i, 1).Value
            Case "CWA000000" To "CWA999999"
 Range("I1").Value = Range("J1").Value
            Case Else
        End Select
    Next i

 End Sub

Thanks for your help

[protonLeah]

    For xrow = lrow To 3 Step -1
        If Left(Range("J" & xrow).Value, 10) = "Delete row" Then Rows(xrow).Delete
    Next xrow
    
    For Each testcell In Range("J2:J" & lrow)
        If Left(testcell.Value, 3) = "CWA" Then
            Range("I" & testcell.Row).Value = testcell.Value
        End If
    Next testcell

[labrooy]

Thanks for the quick reply. I added your code and tested it. It works but not quite how I want it. It does not delete the final row where column J has "Delete row".

Also, I only want it to delete rows where the value starts with "Delete row -" and leave rows starting with "Delete row w". I tried to code this using what I thought was the wildcard * but it is not working.

Sub del()
Dim lrow As Long
Dim xrow As Long

' Here I am trying to delete any row where column J has a text string starting with "Delete row -"
lrow = Cells(Rows.Count, "J").End(xlUp).Row
For xrow = lrow To 3 Step -1
            If Left(Range("J" & xrow).Value, 10) = "Delete row" Then Rows(xrow).Delete
Next xrow

' Here I am trying to copy and paste from column J to column I , whenever the value in column J is between "CWA000000" To "CWA999999"
    For Each testcell In Range("J2:J" & lrow)
        If Left(testcell.Value, 3) = "CWA" Then
            Range("I" & testcell.Row).Value = testcell.Value
        End If
    Next testcell

 End Sub

[pike]

or with your code

Sub del()
Dim lrow As Long
Dim xrow As Long
Dim i As Long
Dim y As Long

' Here I am trying to delete any row where column J has a text string starting with "Delete row -"
lrow = Cells(Rows.Count, "J").End(xlUp).Row
For xrow = lrow To 3 Step -1
    If InStr(1, Range("J" & xrow).Value, "Delete row") > 0 Then Rows(xrow).Delete xlShiftUp
Next xrow

' Here I am trying to copy and paste from column J to column I , whenever the value in column J is between "CWA000000" To "CWA999999"
y = Cells(Rows.Count, "J").End(xlUp).Row
   For i = 2 To y
       Select Case Cells(i, 10).Value
            Case "CWA000000" To "CWA999999"
           Cells(i, 9).Value = Cells(i, 10).Value
            Case Else
        End Select
    Next i

 End Sub

[rscsmith]

Hi

Here's my version:

Sub Del2()
Dim sRow As Single, sLRow As Single, cel As Range

Application.Calculation = xlCalculationManual

sLRow = ActiveSheet.UsedRange.Rows.Count
'Check each cell in column J

'We don't want to do anything in the titles, so only use rows 2 and onwards
'Need to step backwards to avoid confusion - deleting rows
'affects row numbers beneath, so start at the bottom!
For sRow = sLRow To 2 Step -1

Set cel = Cells(sRow, 10)
'If the cell value is between these two values, then do the copy.
'Offset -1 column is column I
 Select Case cel.Value
   Case "CWA000000" To "CWA999999"
     cel.Offset(0, -1).Value = cel.Value
   End Select
 
'If Delete Row is found, then delete the row
 If InStr(UCase(cel.Value), "DELETE ROW") > 0 Then
   Rows(cel.Row).Delete Shift:=xlUp
   End If
  
'Check the next cell
 Next sRow
Application.Calculation = xlCalculationAutomatic

End Sub

Best regards, Rob.

[labrooy]

Thanks pike, that did exactly what I needed, just had to add a hyphen in the appropriate place.

Thank you both for the quick response and efforts.

[rscsmith]

Like I was way tooooo slloooowww.

[labrooy]

Thank you Rob for the alternative and all the useful explanations !

[pike]

never to slow you probably dont have broad band in sydney

[labrooy]

I am running the macro and getting a Runtime Error 13 Type mismatch

In pike's code it is at line: If InStr(1, Range("J" & xrow).Value, "Delete row") > 0 Then

In Rob's code it is at line: Case "CWA000000" To "CWA999999"

[snb]

Sub snb()
  columns(10).replace "Delete row -*",""
  columns(10).specialcells(4).entirerow.delete

  sn=columns(10).specialcells(2).resize(,2)
  for j=1 to ubound(sn)
    if left(sn(j,1),3)="CWA" and Val(mid(sn(j,1),4))>0 and val(mid(sn(j,1),4))<=999999 then sn(j,2)=sn(j,1)
  next

  columns(10).specialcells(2).resize(,2)=sn
End Sub

[pike]

When you click a macro or you click a function on a menu that was created by another macro, you may receive the following error message:
Runtime Error 13 Type mismatch
have you changed the data from the example workbook?

[labrooy]

The data from the example workbook is different to the data in my real workbook -the real workbook has vlookup formula in the relevant cells.



snb - thanks I will take a look at that alternative too.

[labrooy]

snb - your code does not work on the vlookup cells. I could change the vlookup values to text, but I would need to amend another macro to then add the vlookup again. I'm not sure if it is easier to amend one of the macro's everyone has provided, or copy/paste the vlookup results.

It returns an error on line Columns(10).SpecialCells(4).EntireRow.Delete if there are no rows to delete. This should not be a problem as theoretically there will always be rows to delete.

It also returns a run-time error 1004 Application/object defined error on line sn = Columns(10).SpecialCells(2).Resize(, 2)

[pike]

Hi labrooy,
I cant replicate the errors

[labrooy]

I have managed to successfully run your code and Rob's code on a new sample file with vlookups included.

On the real file, your code still gives me a Type 13 error, after successfully deleting all the "Delete row" values it gives the error on the same InStr line.

If InStr(1, Range("J" & xrow).Value, "Delete row -") > 0 Then

If it helps, the Yellow Debug highlighting stops at the end of Then

[pike]

can you zip and attach the problem workbook?

[pike]

just tried the code with 1000 lines an cant reproduce the error??

[labrooy]

Workbook attached. I have tested the 3 macro solutions in this workbook and receive errors for 2 of them and the other one does not seem to work as intended.

[pike]

The error in the cells is causing the problem

use

Sub del()
Dim lrow As Long
Dim xrow As Long
Dim i As Long
Dim y As Long
application.screenupdating=false
on error resume next
' Here I am trying to delete any row where column J has a text string starting with "Delete row -"
lrow = Cells(Rows.Count, "J").End(xlUp).Row
For xrow = lrow To 3 Step -1
    If InStr(1, Range("J" & xrow).Value, "Delete row") > 0 Then Rows(xrow).Delete xlShiftUp
Next xrow

' Here I am trying to copy and paste from column J to column I , whenever the value in column J is between "CWA000000" To "CWA999999"
y = Cells(Rows.Count, "J").End(xlUp).Row
   For i = 2 To y
       Select Case Cells(i, 10).Value
            Case "CWA000000" To "CWA999999"
           Cells(i, 9).Value = Cells(i, 10).Value
            Case Else
        End Select
    Next i
application.screenupdating=true
 End Sub

[labrooy]

Thanks pike.

The new version deletes all the rows where column J = #N/A

[pike]

cant remember if 2003 has iferror
but if you change the formula to display blank in stead of #N/A

     
    ' Extend the formulas in column I and J to the end of the worksheet
    
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-9],Working!R1C[-6]:R236C[-5],2,FALSE),"""")"
    y = Worksheets("Raw Data").Cells(Rows.Count, "E").End(xlUp).Row
    Range("I2").AutoFill Destination:=Range("I2:I" & y), Type:=xlFillDefault

[snb]

Sub snb()
  UsedRange.Columns(11) = UsedRange.Columns(10).Value
  Columns(11).Replace "Delete row -*", ""
  Columns(11).SpecialCells(4).EntireRow.Delete

  sn = Columns(11).SpecialCells(2)
  For j = 1 To UBound(sn)
    If Left(sn(j, 1), 3) <> "CWA" Then
        sn(j, 1) = ""
    Else
        If Val(Mid(sn(j, 1), 4)) < 1 Or Val(Mid(sn(j, 1), 4)) > 999999 Then sn(j, 2) = ""
    End If
  Next

  Columns(11).SpecialCells(2) = sn
End Sub