Code to copy over row if certain criteria is met

[joyrichter]

Good day

I need help with the following code;

I need to copy rows from one sheet to another sheet if certain information on the first sheet appears on 2 other sheets, the rows on the first sheets should automatically copy if the criteria is met.

For example: if Cell A1 in sheet 1(Non moving stock) = cdx123 and cdx123 appears on sheet 2 (Eindvoorraad) and sheet 3 (GRN), the information that is in the row of A on sheet 1 needs to copy over to a recon sheet.

This is the code I have managed to write so far:




'purpose: to consolidate the obeslete stock into one worksheet

'step 1: declare the worksheet variables
Dim wsRecon As Worksheet
Dim wsNon_moving_stock As Worksheet
Dim wsEindvoorraad As Worksheet
Dim wsGRN As Worksheet


'step 2: assign worksheets to the above variables
Set wsRecon = Worksheets("Recon")
Set wsNon_moving_stock = Worksheets("Non_Moving_Stock")
Set wsEindvoorraad = Worksheets("Eindvoorraad")
Set wsGRN = Worksheets("GRN")



'Step3: Declare last row variables
Dim lastrow_Recon As Long
Dim lastrow_Non_moving_Stock As Long
Dim lastrow_Eindvoorraad As Long
Dim lastrow_GRN As Long
Dim Cell As Range
Dim FinalRow As Long

'step4: Determine last rows for Non Moving Stock, Eindvoorraad, GRN

lastrow_Recon = wsRecon.Cells(Rows.Count, 1).End(xlUp).Row
lastrow_Non_moving_Stock = wsNon_moving_stock.Cells(Rows.Count, 1).End(xlUp).Row
lastrow_Eindvoorraad = wsEindvoorraad.Cells(Rows.Count, 1).End(xlUp).Row
lastrow_GRN = wsGRN.Cells(Rows.Count, 1).End(xlUp).Row


With Non_moving_stock

'Apply loop for column A until last cell with value

For Each Cell In .Range("A4:K" & .Cells(.Rows.Count, "A").End(xlUp).Row)

'Apply condition to match the "EINDVORRAAD" value

If Cell.Value = "EINDVOORRAAD" Then

'Command to Copy and move to a destination Sheet "RECON"

.Rows(Cell.Row).Copy Destination:=Recon.Rows(FinalRow2 + 1)

FinalRow2 = FinalRow2 + 1

'Apply condition to match the "GRN" value

ElseIf Cell.Value = "GRN" Then

'Command to Copy and move to a destination Sheet "Recon"

.Rows(Cell.Row).Copy Destination:=Recon.Rows(FinalRow2 + 1)

FinalRow2 = FinalRow2 + 1

End If

Next Cell

End With

Can you please help me

Thanking you in advance

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[joyrichter]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Good day

Thank you for your reply

I have saved the folder to dropbox. The link is below:

Recon - Obselete Stock - 900 and 405 - COPY.xlsm

Shared with Dropbox

www.dropbox.com

This transfer expired

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

If you could please help me with the folllowing code:

The code need to check if the CDX on Sheet (NonMovingStock) in Column A5 appears on the sheets ClosingStock and GRN, if the CDX code appears the code must copy the entire row in the NoMovingStock to a recon, the recon must also show columns were it can confirm that the CDX appears in the ClosingStock and GRN sheets.

for example if:

CDX AD-WD2025 on sheet Non Moving Stock (A5) appears on Closing stock sheet and GRN, the info that must be copied in row 5 on Non-Moving stock is the following up to Column G ( Cost Price)

A D-WD2035

DOLMAR W&D V.CLEANER WD-2035

NN - HARDEWARE

2022-11-01​

0001-01-01

3 034.50

Please add a column with the heading Closing Stock 202401 and a column GRN-082023, which are answered with yes if the appear on the sheet Closing Stock and GRN

I hope this is more clear on what the code needs to be

Thank you i appreciate your help.

Joy

 

[joyrichter]

Good day

Thank you for your reply

I have saved the folder to dropbox. The link is below:

Recon - Obselete Stock - 900 and 405 - COPY.xlsm

Shared with Dropbox

www.dropbox.com

This transfer expired

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

If you could please help me with the folllowing code:

The code need to check if the CDX on Sheet (NonMovingStock) in Column A5 appears on the sheets ClosingStock and GRN, if the CDX code appears the code must copy the entire row in the NoMovingStock to a recon, the recon must also show columns were it can confirm that the CDX appears in the ClosingStock and GRN sheets.

for example if:

CDX AD-WD2025 on sheet Non Moving Stock (A5) appears on Closing stock sheet and GRN, the info that must be copied in row 5 on Non-Moving stock is the following up to Column G ( Cost Price)

A D-WD2035

DOLMAR W&D V.CLEANER WD-2035

NN - HARDEWARE

2022-11-01​

0001-01-01

3 034.50

Please add a column with the heading Closing Stock 202401 and a column GRN-082023, which are answered with yes if the appear on the sheet Closing Stock and GRN

I hope this is more clear on what the code needs to be

Thank you i appreciate your help.

Joy

If possible the recon sheet should look like this in the end:

cdx	Cardex Description	Main Group	Sub Group	Last GOB Date	Last Sales Date	Cost Price	Closing Stock 202401	GRN 202308 - 140 - 405
A D-WD2035	DOLMAR W&D V.CLEANER WD-2035	NN - HARDEWARE		2022-11-01	0001-01-01	3 034.50	yes	yes

 

[joyrichter]

If possible can the code also please copy the amount in Column P on the GRN sheet to the recon sheet under the heading - GRN Cost price and the cost price in closing stock in Column I to the recon sheet under the heading closing stock cost price

for example:

cdx	Cardex Description	Main Group	Sub Group	Last GOB Date	Last Sales Date	Cost Price	Closing Stock 202401	Closing stock Cost Price	GRN 202308 - 140 - 405	GRN Cost Price
A D-WD2035	DOLMAR W&D V.CLEANER WD-2035	NN - HARDEWARE		2022-11-01	0001-01-01	3 034.50	yes	3034.5​	yes	3 034.50

This is my last request, I would be so grateful if you could help me I am struggling to write the code.

 

[mumps]

Both links you posted are for the same file (Obsolete Stock). Please update the links.

 

[joyrichter]

Apologies I duplicated the link be mistake

Here is the final link

Recon - Obselete Stock - 900 and 405 - COPY.xlsm

Shared with Dropbox

www.dropbox.com

 

[joyrichter]

The file contains all 3 sheets mentioned above

 

[joyrichter]

The 3 sheets are on separate tabs on the file shared.

The file contains all 3 sheets mentioned above

 

[mumps]

Try:

Sub CopyRow()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, ws1 As Worksheet, ws2 As Worksheet
    Dim v1 As Variant, v2 As Variant, v3 As Variant, dic As Object, i As Long, ii As Long
    Set srcWS = Sheets("NonMovingStock")
    Set desWS = Sheets("Recon")
    Set ws1 = Sheets("ClosingStock") 'delete trailing space
    Set ws2 = Sheets("GRN") 'delete trailing space
    v1 = srcWS.Range("A5", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = ws1.Range("C2", ws1.Range("C" & Rows.Count).End(xlUp)).Value
    v3 = ws2.Range("I1", ws2.Range("I" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), i + 4
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            For ii = LBound(v3) To UBound(v3)
                If dic.exists(v2(i, 1)) Then
                    desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 7).Value = srcWS.Range("A" & dic(v2(i, 1))).Resize(, 7).Value
                    Exit For
                End If
            Next ii
        End If
    Next i
    Application.ScreenUpdating = True
End Sub