Use of AutoFilter to update Inventory sheet

[Anthony904]

I have a spreadsheet that keeps an Inventory of some backup tapes.

The spreadsheet looks like so:

Worksheet: "Tape Data"
Slot Tape Date Used
1 ABC 4/9/07 Full
2 CBS 4/8/07 Full
3 NBC -------- 0%

Slot = Where the tape currently resides in the jukebox
Tape = Name of tape
Used = Amount stored on the tapes
Date = Represents the date the tapes where taken out of the jukebox + 90 days (data retention period)

The spreadsheet finds fields that are marked "Full" and moves it over to worksheet "Inventory" and clear the contents from "Tape Data".

The code below works fine if column "Used" has a "Full" tape, but if there is not it copies all tapes over "Full" or not. It also clears the "Tape Data" worksheet.

Private Sub CommandButton1_Click()
Dim rg As Range
Dim ws As Worksheet, wsUpload As Worksheet

On Error Resume Next

Application.ScreenUpdating = False
Set wsUpload = Worksheets("Inventory")
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Inventory" Then
        Set rg = Intersect(ws.UsedRange, ws.Range("B:D"))
        rg.AutoFilter Field:=3, Criteria1:="Full"    'The 3 refers to the third column in the filtered range
        rg.Offset(1, 0).Resize(rg.Rows.Count - 1).Copy wsUpload.Cells(65536, 1).End(xlUp).Offset(1, 0)
        rg.Offset(1, 0).Resize(rg.Rows.Count - 1).ClearContents
        ws.Cells(1, 1).AutoFilter
        rs.Delete
    End If
Next
Application.ScreenUpdating = True

MsgBox "Tapes Moved to ""Inventory"""
End Sub

Thanks.

 

[PHV]

Have you tried to play with the SpecialCells(xlCellTypeVisible) method and the Count property of the Range object ?

BTW, what is rs ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[WinblowsME]

Private Sub CommandButton1_Click()
   Dim i As Long, j As Integer, last_row As Long, tape_data As String, inventory As String, moved As Boolean

   On Error Resume Next
   
   Application.ScreenUpdating = False
   
   tape_data = "Tape Data"
   inventory = "Inventory"
   moved = False
   
   For i = 2 To Get_Last_Row(tape_data)
      If UCase(Trim(Sheets(tape_data).Range("D" & i))) = "FULL" Then
         moved = True
         
         last_row = Get_Last_Row(inventory)
         last_row = last_row + 1
         
         For j = 2 To 4
            Sheets(inventory).Cells(last_row, j - 1) = Sheets(tape_data).Cells(i, j)
            Sheets(tape_data).Cells(i, j) = ""
            
            If j = 3 Then
               Sheets(inventory).Cells(last_row, j - 1).NumberFormat = "M/DD/YY"
            End If
         Next j
      End If
   Next i

   Application.ScreenUpdating = True

   If moved Then
      MsgBox "Tapes Moved to " & Chr(34) & inventory & Chr(34)
   Else
      MsgBox "There are no full tapes"
   End If
End Sub

Private Function Get_Last_Row(sheet_name As String) As Long
   Get_Last_Row = Sheets(sheet_name).Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
End Function

 

[Anthony904]

PHV,

Thanks I'll look at what you suggested.

WinblowsMe,

Thanks! This works great!