Sorting List and moving cells to another location

EnderLexus

New Member
Joined
Nov 20, 2023
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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
1740654221249.png




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



If anyone is able to help would be much appreciated :)
 
This code worked for me...

VBA Code:
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...
1740663902553.png


My after...
1740663933357.png


I'm offline now for a few days but hope this will be of help.
 
Upvote 0
Try.
VBA Code:
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
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top