VBA to find unique code, copy whole row to new worksheet, do next until end of used rows?

[Belinea2010]

Windows 10
Excel 2019


I have searched extensively online without understanding much of what is returned and
I have searched this forum but all posts on here are empty of any text for some treason.

What I am trying to achieve is that the VBA code looks at the "Stock Inventory" worksheet, cycles or looks at each row from what would be Column A to G, and returns the first unique row based on the Unique Code in Column G.

So in the example below, from the "Stock Inventory" worksheet it would copy, Rows 8, 10, 15 and 18 into the "Product Summary" worksheet.


Column A = Product Base
Column B = Product type
Column C = Pack type
Column D = Pack Size
Column E = Supplier
Column F = Unique Code (this could be a all numbers, all letters or mix of both)
Column G = Stock Level
Column H = Reorder

Due to various reasons, there will be duplicate entries of the same product with the same Unique Code.

Using VBA, I need it to look at each row in the worksheet ?Stock Inventory?,
find the first occurance of a block of unique code in Column F,
select that row from Column A to Column F,
and copy the data into the appropiate "pre-defined" columns in the worksheet "Product Summary"
move on to the next block of unique code.
continue until the end of used cells

I am unable to work out how to achieve this.

If anyone is able to help I have attached an example workbook.

Thanks in advance

[TMS]

You could just copy the whole range to the Product Summary and then use the Remove Duplicates functionality.

See: https://support.microsoft.com/en-us/...e-66a552dc138d

[beyond Excel]

Hello. You have two basic ways to do it:

a) Copy the entire data range to another sheet and there apply the 'Remove Duplicates' method (it's what @TMS told you), or

b) Apply an Advanced Filter and do the same in one step: I show you this variant.

Sub Macro8()
Dim Rng As Range
Set Rng = Range("'Stock Inventory'!A1").CurrentRegion.Resize(, 6)
With Sheets("Product Summary")
  .Cells(1).CurrentRegion.Delete xlShiftUp
  .Cells(2, 1) = "=CountIf(" & "'" & Rng.Worksheet.Name & "'!F$2:F2, '" & _
    Rng.Worksheet.Name & "'!F2) = 1"
  Rng.AdvancedFilter 2, .Range("A1:A2"), .Range("A3"), False
  .Rows("1:2").Resize(, 6).Delete xlShiftUp
End With
End Sub