Ignoring rows with zero value [Solved/Closed]

Report
-
Posts
365
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
-
Hello,

A couple weeks ago ya'll helped me with some code to compare two sheets and create a new worksheet with all of the values that were identical. Now I'm trying to make it so that the code ignores a value of Zero(0) in the "K" column when the information is transferred over. Either that or delete any rows in which the value is 0 in the K column of the new worksheet. I know that I can just use the Auto Filter, and that is what I'm currently doing, but I figured I could add a couple lines of code and make that unneccesary.

This is the code that I am currently using...

Sub CompareExpendables()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both

    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer
    Dim sh2row As Integer
    Dim sh1col As Integer
    Dim sh2col As Integer
    Dim rng1ct As Range
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a" & Rows.Count).End(xlUp).Row
    sh1col = sh1.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("b" & Rows.Count).End(xlUp).Row
    sh2col = sh2.Range("b" & Columns.Count).End(xlToLeft).Column
    Set rng2ct = sh2.Range("b3").Resize(sh2row, sh2col)
        
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    sh2.Range("a2:l2").Copy Destination:=Worksheets(3).Range("a1:l1")
    Worksheets(3).Columns("A:A").ColumnWidth = 7
    Worksheets(3).Columns("B:B").ColumnWidth = 20
    Worksheets(3).Columns("C:C").ColumnWidth = 64
    Worksheets(3).Columns("L:L").ColumnWidth = 12.2
        
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row1 = row2 Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    
End Sub

I've tried adapting a few subs I've seen online, but none seem to mesh well with what I'm currently using. If you could at least point me in the right direction it would be greatly appreciated.

Thank you,
Chris

3 replies

Posts
365
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
118
use following line in the end of your code.


Dim lastRow As Long
Dim i As Integer

lastRow = Range("K" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
 If Range("K" & i) = "" Then Exit For
 If Range("K" & i).Value = 0 Then
 Range("K" & i).EntireRow.delete
 i = i - 1
 End If
 Next i

1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

You're a lifesaver! It works flawlessly. That eliminates about 4000 lines that I was sorting through originally. :)
Posts
365
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
118
You Are Most Welcome

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!