Copy row data between sheets when duplicate value is inserted in other sheet

[Tuggles]

Hi all. Have been trying to get my head around vba but unsuccessful so far. Hopefully somebody can help.
I am using excel 2003 on XP & have attached sample workbook. I’m trying to setup up a document to track stock. There are two sheets “Stock” & “Allocation” which both will go from row 2 - 999. I’m trying to get it so that when you type a number into Allocation “Roll Number”, the macro will scan Stock “Roll Number” to find the same number.
Then it will copy the adjacent cell “Roll Ref Nr” to Allocation Sheet,
Move ” Weight”” Size”” Thickness”” to Allocation Sheet
And delete “Remaining Length” from “Stock” all in the same row.

Also if the number is typed twice in “allocation” it will do nothing and not copy blank spaces from “Stock” when I run it a second time.
This may be too awkward but any help would be much appreciated. Cheers.

Excel Workbook
	A	B	C	D	E	F	G
1	Roll Number	Roll Ref Nr	Weight	Size	Thickness	Remaining Length	Coresponding Profile
2	1	Sample Ref no 1	1200	187	1.20	681	90mm
3	2	Sample Ref no 2	2002	361	1.50	471	250mm
4	3	Sample Ref no 3	1988	361	1.50	468	250mm
5	4	Sample Ref no 4	2188	361	1.50	515	250mm
6	6	Sample Ref no 5	2130	361	1.50	501	250mm
7	7	Sample Ref no 6	2026	361	1.50	477	250mm
8	8	Sample Ref no 7	2180	361	1.50	513	250mm
9	9	Sample Ref no 8	2138	361	1.50	503	250mm
10	11	Sample Ref no 9	2158	361	1.50	508	250mm
11	12	Sample Ref no 10	2018	361	1.50	475	250mm
12	13	Sample Ref no 11	3710	311	1.50	1013	200mm
13	14	Sample Ref no 12	3710	311	1.50	1013	200mm
14	15	Sample Ref no 13	2330	311	1.50	636	200mm
15	16	Sample Ref no 14	2230	311	1.50	609	200mm
16	17	Sample Ref no 15	2200	311	1.50	601	200mm
17	18	Sample Ref no 16	*	*	*	*	-
18	19	Sample Ref no 17	2325	311	1.50	635	200mm
19	21	Sample Ref no 18	2325	311	1.50	635	200mm
20	23	Sample Ref no 19	*	*	*	*	-
21	24	Sample Ref no 20	2267	311	1.50	619	200mm
22	26	Sample Ref no 21	2200	311	1.50	601	200mm
23	27	Sample Ref no 22	2325	311	1.50	635	200mm
24	28	Sample Ref no 23	1957	311	1.50	534	200mm
25	29	Sample Ref no 24	2780	255	0.95	1462	140mm
26	30	Sample Ref no 25	*	*	*	*	-
27	32	Sample Ref no 26	1330	187	1.50	604	90mm
28	33	Sample Ref no 27	1330	187	1.50	604	90mm
29	35	Sample Ref no 28	1330	187	1.50	604	90mm
30	36	Sample Ref no 29	1254	187	1.50	570	90mm
31	37	Sample Ref no 30	1955	255	1.50	651	140mm
32	38	Sample Ref no 31	1955	255	1.50	651	140mm
33	39	Sample Ref no 32	1955	255	1.50	651	140mm
34	40	Sample Ref no 33	*	*	*	*	-
35	41	Sample Ref no 34	1900	255	1.50	633	140mm
36	42	Sample Ref no 35	1900	255	1.50	633	140mm
37	43	Sample Ref no 36	1900	255	1.50	633	140mm
38	44	Sample Ref no 37	1955	255	1.50	651	140mm
39	45	Sample Ref no 38	*	*	*	*	-
40	46	Sample Ref no 39	*	*	*	*	-
41	47	Sample Ref no 40	2706	361	1.50	637	250mm
42	48	Sample Ref no 41	2706	361	1.50	637	250mm
43	49	Sample Ref no 42	2820	361	1.50	663	250mm
44	50	Sample Ref no 43	2820	155	1.50	1545	70mm
45	51	Sample Ref no 44	2583	155	1.50	1415	70mm
46	52	Sample Ref no 45	596	155	1.50	327	70mm
47	53	Sample Ref no 46	1157	187	1.50	525	90mm
48	54	Sample Ref no 47	1157	187	1.50	525	90mm
49	55	Sample Ref no 48	*	*	*	*	-
50	56	Sample Ref no 49	*	*	*	*	-
51	57	Sample Ref no 50	1880	255	1.20	783	140mm
52	58	Sample Ref no 51	1880	255	1.20	783	140mm
53	59	Sample Ref no 52	1880	255	1.20	783	140mm
54	60	Sample Ref no 53	1880	255	1.20	783	140mm
55	61	Sample Ref no 54	1880	255	1.20	783	140mm
56	62	Sample Ref no 55	1390	187	1.20	789	90mm
57	63	Sample Ref no 56	1390	187	1.20	789	90mm
58	64	Sample Ref no 57	1250	187	1.20	710	90mm
59	65	Sample Ref no 58	1250	187	1.20	710	90mm
60	66	Sample Ref no 59	1250	187	1.20	710	90mm
61	67	Sample Ref no 60	*	*	*	*	-
62	68	Sample Ref no 61	*	*	*	*	-
63	69	Sample Ref no 62	*	*	*	*	-
64	70	Sample Ref no 63	*	*	*	*	-
Stock

Excel Workbook
	A	B	C	D	E	F	G	H
1	Roll Number	Roll Ref Nr	Weight [kg]	Size [mm]	Thickness [mm]	Contract No.	Contract Description	Use [%]
2	16	Sample Ref no 14	2230	311	1.50	C0001	13 Backward Street	100
3	23	Sample Ref no 19	2267	311	1.50	C0002	Snap	100
4	40	Sample Ref no 33	1955	255	1.50	C0001	13 Backward Street	100
5	55	Sample Ref no 48	1618	361	1.50	C0002	Snap	100
6	56	Sample Ref no 49	1880	255	1.20	C0001	13 Backward Street	100
7	30	Sample Ref no 25	1330	187	1.50	C0001	13 Backward Street	100
8	45	Sample Ref no 38	2196	255	1.50	C0004	Seaside	100
9	46	Sample Ref no 39	2820	361	1.50	C0005	The Grassy Knoll	100
10	67	Sample Ref no 60	1250	187	1.20	C0015	The Grassy Knoll	100
11	68	Sample Ref no 61	1350	187	1.20	C0004	Seaside	100
12	69	Sample Ref no 62	1350	187	1.20	C0002	Snap	100
13	70	Sample Ref no 63	1350	187	1.20	C0001	13 Backward Street	100
14	*	*	*	*	*	*	*	*
15	*	*	*	*	*	*	*	*
16	*	*	*	*	*	*	*	*
17	*	*	*	*	*	*	*	*
18	*	*	*	*	*	*	*	*
19	*	*	*	*	*	*	*	*
20	*	*	*	*	*	*	*	*
Allocation

 

[AlphaFrog]

Right-click on the sheet tab "Allocation" and select View Code. Paste the macro below in the VBA edit window.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Range
    
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("A2:A999")) Is Nothing Then
        
            Application.EnableEvents = False
            On Error Resume Next
            
            If Application.CountIf(Range("A2:A999"), Target.Value) > 1 Then
                Target.ClearContents        'Duplicate entry
                
            Else
                Set r = Sheets("Stock").Range("A2:A999").Find(Target.Value, LookAt:=xlWhole, MatchCase:=False)
                
                If r Is Nothing Then
                    Target.ClearContents    'No match found
                Else
                    Target.Offset(, 1).Resize(, 4).Value = r.Offset(, 1).Resize(, 4).Value
                    r.Offset(, 2).Resize(, 5).ClearContents 'Clear cells on Stock sheet?"
                End If
                
            End If
            
            On Error GoTo 0
            Application.EnableEvents = True
            
        End If
    End If
End Sub

 

[Tuggles]

AlfaFrog you are a legend. Thanks for getting back so quick. Does exactly what I asked and works perfectly but have realized that might need to type duplicates in the allocation sheet, “roll number” as sometimes only half a roll is used. So still need it to scan the stock sheet but then not delete duplicates in the Allocation Sheet. Thanks again and sorry for buggin!

 

[AlphaFrog]

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Range
    
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("A2:A999")) Is Nothing Then
        
            Application.EnableEvents = False
            On Error Resume Next
            
                Set r = Sheets("Stock").Range("A2:A999").Find(Target.Value, LookAt:=xlWhole, MatchCase:=False)
                
                If r Is Nothing Then
                    Target.ClearContents    'No match found
                Else
                    Target.Offset(, 1).Resize(, 4).Value = r.Offset(, 1).Resize(, 4).Value
                    
                End If
                
            End If
            
            On Error GoTo 0
            Application.EnableEvents = True
            
        End If
    End If
End Sub

 

[Tuggles]

Have put code into document but it throws up an error
Compile error
End If without Block If
Tried editing but not able for it. Took out the last End If which was highlighted but then Macro just deleted each number i typed into Allocation sheet. Cheers Tuggles.

 

[AlphaFrog]

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Range
    
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("A2:A999")) Is Nothing Then
        
            Application.EnableEvents = False
            On Error Resume Next
            
                Set r = Sheets("Stock").Range("A2:A999").Find(Target.Value, LookAt:=xlWhole, MatchCase:=False)
                
                If r Is Nothing Then
                    Target.ClearContents    'No match found
                Else
                    Target.Offset(, 1).Resize(, 4).Value = r.Offset(, 1).Resize(, 4).Value
                    
                End If
            
            On Error GoTo 0
            Application.EnableEvents = True
            
        End If
    End If
End Sub

 

[Tuggles]

AlfaFrog again that code works really well but its not just doing exactly what i need. As with the first code it moves,copies & deletes all the data from Stock to Allocation but then i'd like to have the option to type the Roll number again in Allocation to split usage of roll between jobs. Have attached a sample.

Excel Workbook
	A	B	C	D	E	F	G	H
4	40	Sample Ref no 33	1955	255	1.50	C0001	13 Backward Street	100
5	55	Sample Ref no 48	1618	361	1.50	C0002	Snap	50
6	55	Sample Ref no 13	1618	361	1.50	C0002	Snap	50
7	56	Sample Ref no 49	1880	255	1.20	C0001	13 Backward Street	100
8	30	Sample Ref no 2	1330	187	1.50	C0001	13 Backward Street	80
9	30	Sample Ref no 25	1330	187	1.50	C0001	13 Backward Street	20
10	45	Sample Ref no 38	2196	255	1.50	C0004	Seaside	100
Allocation

 

[Tuggles]

Hey AlfaFrog
Copied a bit of code from your 2nd post to your first one and its working spot on.
Thanks for all the help. Max Respect.