Code to copy over row if certain criteria is met

joyrichter

New Member
Joined
Jun 17, 2023
Messages
31
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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

VBA Code:
'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
 
Last edited by a moderator:

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
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).
 
Upvote 0
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:



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-WD2035DOLMAR W&D V.CLEANER WD-2035NN - HARDEWARE
2022-11-01​
0001-01-013 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
 
Upvote 0
Good day

Thank you for your reply

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



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-WD2035DOLMAR W&D V.CLEANER WD-2035NN - HARDEWARE
2022-11-01​
0001-01-013 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:
cdxCardex DescriptionMain GroupSub GroupLast GOB DateLast Sales DateCost PriceClosing Stock 202401GRN 202308 - 140 - 405
A D-WD2035DOLMAR W&D V.CLEANER WD-2035NN - HARDEWARE2022-11-010001-01-013 034.50yesyes
 
Upvote 0
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:
cdxCardex DescriptionMain GroupSub GroupLast GOB DateLast Sales DateCost PriceClosing Stock 202401Closing stock Cost PriceGRN 202308 - 140 - 405GRN Cost Price
A D-WD2035DOLMAR W&D V.CLEANER WD-2035NN - HARDEWARE2022-11-010001-01-013 034.50yes
3034.5​
yes3 034.50

This is my last request, I would be so grateful if you could help me I am struggling to write the code.
 
Upvote 0
Both links you posted are for the same file (Obsolete Stock). Please update the links.
 
Upvote 0
Try:
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,121
Members
452,381
Latest member
Nova88

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