Solved: Is there a shorter way to write my VBA code?

[genracela]

I'm wondering if I there's a shorter way to write this code.

I have 4 tabs/sheets to work on so I used "ThisWorkbook" instead of "ActiveSheet" to delete all rows that has the following criterias in G column, in all my 4 tabs.




Option Explicit
Sub RowNCFT()

With ThisWorkbook
Dim lLastRow As Long
Dim i As Long
lLastRow = Cells(Rows.Count, "G").End(xlUp).Row
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "ACCESSORIES" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "FOOTWEAR" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "HOUSEWARES" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "INNERWEAR" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "ENTERTAINMENT & LEISURE" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "GIFT & DECORATIVE" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "JEWELRY" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "KIDS" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If

If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "NUTRITION" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If

If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "OUTERWEAR" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If

If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "SALESTOOLS" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If

If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "UNKNOWN" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "WATCHES" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If
End With
End Sub




Thanks!!!

[GTO]

Hi there,

Quickly read, but I do not believe you are taking advantage of the With, as the remaining code is not qualified. Also, if you are wanting it do look for stuff on all sheets, you might want a For Each... Next, something like:


Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
'do stuff to the sheet here
Next


Does that help?

Mark

[genracela]

But how about the so many criterias that I have

If G is equal to
"ACCESSORIES"
"FOOTWEAR"
"HOUSEWARES"
"HOUSEWARES"
"INNERWEAR"
"ENTERTAINMENT & LEISURE"
"GIFT & DECORATIVE"
"JEWELRY"
"KIDS"
"NUTRITION"
"OUTERWEAR"
"SALESTOOLS"
"UNKNOWN"
"WATCHES"

These are 14 criterias and I need to write 14 of this code:
If lLastRow >= 2 Then
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "FOOTWEAR" Then
Range("G" & i).EntireRow.Delete
End If
Next
End If


Is there a shorter way than writing(copy pasting) these 14 criterias?

[Bob Phillips]

Sub RowNCFT()

With ThisWorkbook.Activesheet
Dim lLastRow As Long
Dim i As Long
lLastRow = Cells(Rows.Count, "G").End(xlUp).Row
For i = lLastRow To 2 Step -1
If Range("G" & i).Value = "ACCESSORIES" Or _
Range("G" & i).Value = "FOOTWEAR" Or _
Range("G" & i).Value = "HOUSEWARES" Or _
Range("G" & i).Value = "INNERWEAR" Or _
Range("G" & i).Value = "ENTERTAINMENT & LEISURE" Or _
Range("G" & i).Value = "G T & DECORATIVE" Or _
Range("G" & i).Value = "JEWELRY" Or _
Range("G" & i).Value = "KIDS" Or _
Range("G" & i).Value = "NUTRITION" Or _
Range("G" & i).Value = "OUTERWEAR" Or _
Range("G" & i).Value = "SALESTOOLS" Or _
Range("G" & i).Value = "UNKNOWN" Or _
Range("G" & i).Value = "WATCHES" Then
Rows(i).Delete
End If
Next
End With
End Sub

[genracela]

Thanks again XLD!

[GTO]

I have 4 tabs/sheets to work on so I used "ThisWorkbook" instead of "ActiveSheet" to delete all rows that has the following criterias in G column, in all my 4 tabs...

Okay, I'm still not utterly sure that you want to work against all sheets in the wb, or four particular sheets.

Here would be another way, but please note that it is working against all sheets in the wb.

In a test copy of your wb...

In a Standard Module:


Option Explicit

Sub exa()
Dim wks As Worksheet
Dim lLastRow As Long
Dim i As Long

For Each wks In ThisWorkbook.Worksheets

With wks
lLastRow = Application.Max(.Cells(Rows.Count, "G").End(xlUp).Row, 2)

For i = lLastRow To 2 Step -1
If TestVal(.Cells(i, "G").Value) Then
.Cells(i, "G").EntireRow.Delete
End If
Next
End With
Next
End Sub

Function TestVal(Val As String) As Boolean
Static REX As Object

If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
With REX
.Global = False
.IgnoreCase = False
.Pattern = "ACCESSORIES|FOOTWEAR|HOUSEWARES|INNERWEAR|" & _
"ENTERTAINMENT & LEISURE|GIFT & DECORATIVE|" & _
"JEWELRY|KIDS|NUTRITION|OUTERWEAR|SALESTOOLS|UNKNOWN|WATCHES"
End With
End If

If REX.Test(Val) Then TestVal = True
End Function

Hope that helps,

Mark

:hi: Good Mornin' Bob :)

[genracela]

Hmmmm, I'll try that...

Thanks GTO!

[Bob Phillips]

Thanks again XLD!

Personally, I would put the values in a table on a separate (maybe hidden) worksheet, and match against that.