Sorting List and moving cells to another location

[EnderLexus]

Hi there,
Slightly difficult to explain, but I have a sheet which I use to keep track of inventory thats coming in/out. I've built an excel sheet, and have finally decided to ask for help in one part that annoys me :D
I don't believe is fully relevant but for context, the start of the sheet uses a basic collection to link item numbers I put in to their products, then if they don't match it will automatically tag as NOT FOUND

Some products won't match up which is expected, so I'm trying to see if there is a way after I do a sort to move the rows that say not found to the NOT INCLUDED table? My only issue is, sometimes there are 1/2 and other times there can be 10 so its that variation where I'm not sure how to program that as a macro. I have tried and failed to do it as a recorded macro, but that might just be me


So below is a view, after performing a collection, then sorting the cells

Ideally, a macro which can just assign to a button above to create something like below, rather than going through manually.

If anyone is able to help would be much appreciated

 

[sxhall]

This code worked for me...

Sub MoveIt()

Dim i As Long
Dim rng As Range
Dim RowCount As Integer

Application.ScreenUpdating = False

RowCount = 17 ' Hardkeyed row number to start pasting across at, assuming this will be blank to start with?

ActiveSheet.Range(Range("B17"), Range("B17").End(xlDown)).Select
Set rng = Selection
For i = rng.Cells.Count To 1 Step -1
    If rng.Item(i).Offset(0, 1).Value = "Not Found" Then
    rng.Item(i).Resize(1, 2).Copy
    Range("K" & RowCount).PasteSpecial Paste:=xlPasteValues
    rng.Item(i).Resize(1, 6).Delete Shift:=xlUp
    RowCount = RowCount + 1
    Else
    End If
Next i

Application.ScreenUpdating = True

End Sub

Code above will always start pasting across at cell K17.

Starts the search from the bottom of the list to the top so the deleting of a line does not cause it to skip any matches.

My before...

My after...

I'm offline now for a few days but hope this will be of help.

 

[kvsrinivasamurthy]

Try.

Sub CopyData()
Dim R As Range
Dim Lr&
Application.ScreenUpdating = False
Lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B16:F" & Lr)
Range("K17").CurrentRegion.Clear
With R
.AutoFilter Field:=2, Criteria1:="not found"
.SpecialCells(xlCellTypeVisible).Copy Range("K17")
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[saboh12617]

Hello,

The sub below should work. It filters on column C "product name" for "not found" and then copies the results in K17.

Be careful as the macro deletes entire rows for the not found items, so if you have data on the right of those two tables they will be lost.

Option Explicit

Sub Example()
  Dim notFounds() As Variant
  With Sheet1.Range("A16")
    .AutoFilter
    .AutoFilter 3, "not found"
    
    If .Offset(1, 1).End(xlDown).Row = Sheet1.Rows.Count Then Exit Sub
    
    With Range(.Offset(1, 1), .Offset(1, 5).End(xlDown)).SpecialCells(xlCellTypeVisible)
      ReDim notFounds(0 To .Cells.Count / 5, 0 To 4)
      Dim r As Range, c As Range, rowI As Long, colI As Long
      For Each r In .Rows
        colI = 0
        For Each c In r.Cells
          notFounds(rowI, colI) = c.Value2
          colI = colI + 1
        Next c
        rowI = rowI + 1
      Next r
      .EntireRow.Delete
    End With
    .AutoFilter
  End With
  
  With Sheet1.Range("k17")
    If .Value <> vbNullString Then .ClearContents
    .Resize(UBound(notFounds, 1) + 1, UBound(notFounds, 2) + 1).Value2 = notFounds
  End With
End Sub