Loop through worksheet and set value of highlighted rows on other sheet

[DrParmeJohnson]

Hello,
I am trying to make this macro work as it only works partly now.

Sub LP_Order()


'Highlight OutOfStocks based on user input

Application.Run "PERSONAL.XLSB!dHighlightCells"

'Take Highlighted OOS's and cut them onto a new Sheet

Dim i As Integer
Dim exists As Boolean

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Out Of Stocks" Then
        exists = True
    End If
Next i

If Not exists Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Out Of Stocks"
End If

Dim c As Range
Dim Lastrow As Integer
Dim Lastrow2 As Integer
Dim ws1 As Worksheet
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Lastrow2 = Worksheets("Out Of Stocks").Cells(Rows.Count, "A").End(xlUp).Row
Set ws1 = Worksheets(1)
Range("C$2:C" & Lastrow).Value = Range("C$2:C" & Lastrow).Value
Range("D$2:E" & Lastrow).EntireColumn.Delete
Worksheets("Out Of Stocks").Range("A1").Value = "id"
Worksheets("Out Of Stocks").Range("B1").Value = "Description"
Worksheets("Out Of Stocks").Range("C1").Value = "Qty"


For Each c In ws1.Range("A$2:C" & Lastrow)
    If c.Interior.Color = vbYellow Then
    Worksheets("Out of Stocks").Range("A$2:C" & Lastrow2).Offset(1, 0).Value = c.EntireRow.Value
    End If
Next c

Worksheets("Out Of Stocks").Cells.EntireColumn.AutoFit
Application.CutCopyMode = False



End Sub

The function is as follows:
It first prompts the user to select which range to highlight yellow.
It then checks for a sheet and if it doesn't exist, it adds it.
The next part gets weird and I don't know where I go wrong.

What I'm trying to make happen is for the macro to loop through Range("A$2:C" & Lastrow), find all the highlighted rows, copy their entire value (just 3 cells A#,B#,C#) to a second sheet ("Out of Stocks") and on that second sheet copy each row to a row below the "Lastrow2" (Last row on 2nd sheet) and do so until there are no more highlight columns.
I would also like to add a part that deletes the entirerow that is highlighted after it has been copied to the other sheet.
Both sheets (the first and second) look like this:
But the second sheet is blank and only contains the names in A1, B1, C1.

id	Description	qty
1000	name1	5
1500	name2	7
2000	name3	10

When I run the macro now, it only copies the first value that was highlighted (I think). It seems a bit picky in that sense.

I'm not sure what the issue is, so if anyone can assist, I would appreciate it greatly.

Thanks.

 

[DanteAmor]

?‍

Sub LP_Order()
   'Highlight OutOfStocks based on user input
   Application.Run "PERSONAL.XLSB!dHighlightCells"
   'Take Highlighted OOS's and cut them onto a new Sheet
   
   Application.ScreenUpdating = False
   If Not Evaluate("Isref('Out Of Stocks'!A1)") Then
       Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Out Of Stocks"
   End If
   
   Dim Lastrow As Integer
   Dim ws1 As Worksheet
   
   Set ws1 = Worksheets(1)
   Lastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
   ws1.Range("C2:C" & Lastrow).Value = ws1.Range("C2:C" & Lastrow).Value
   ws1.Range("D:E").EntireColumn.Delete
   
   With Worksheets("Out Of Stocks")
      .Range("A1").Value = "id"
      .Range("B1").Value = "Description"
      .Range("C1").Value = "Qty"
   
      ws1.Range("A1:C" & Lastrow).AutoFilter 1, RGB(255, 255, 0), xlFilterCellColor
      ws1.AutoFilter.Range.Range("A2:C" & Lastrow).Copy
      .Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
      .Cells.EntireColumn.AutoFit
      ws1.AutoFilter.Range.Offset(1).EntireRow.Delete
      ws1.ShowAllData
   End With
   Application.CutCopyMode = False
End Sub

 

[DrParmeJohnson]

Forgot to add this

Ws.Autofiltermode=False

Yep, that was it. Thank you.

If I want to sort the second worksheet by the id column, will it be something like

With Worksheets("Out Of Stocks")
.Range("A$2:A" & Lastrow).Sort Key1:=Range("A1"), Order1:=xlDescending

 

[Fluff]

Yup, that should be fine.

 

[DrParmeJohnson]

Yup, that should be fine.

When I try to run it, it says the sort by reference is not valid. Not sure what for.

 

[Fluff]

Oops, you're missing a full stop in front of the Range("A1")

 

[DrParmeJohnson]

Oops, you're missing a full stop in front of the Range("A1")

Oh yep, got it. That works now. Thank you again.

This macro is part of a larger project so, you may get more of this in the future. Still learning all of this stuff as I'm trying to go through and develop this macro.

 

[Fluff]

Glad to help & thanks for the feedback

 

[DrParmeJohnson]

Glad to help & thanks for the feedback

I have another question that hopefully isn't too difficult, can I ask you here or should I just make a new post as it's mostly unrelated to this problem?

 

[Fluff]

If it's unrelated to this thread, then please start a new one. Cheers