Need help with VBA code

[DarkSmile]

Hi,

I need some help with VBA code, I tried it myself but it's not working.

Sub ACS002()
  If Sheets("List").Range("C17") = True Then
  Sheets("ACS-002").Range("A2:B32").Copy Destination:=Sheets("Data").Range("A11")
End Sub

So i have a sheet with a dropdown list where you can choose the norms, I have a list with formulas that looks if the specific norm has been chosen and if so returns TRUE.
What I'm trying to do with the VBA now is look if in specific cell it says TRUE, if so go to specified sheet and copy specific range and paste it in sheet Data starting at range A11.

VBA should be changed a bit so it says; Start a A11 , but for the other once (because I will copy/paste all the norms) paste them underneath the previous one (but skip one row).

Result:

Excel aanduiden welke normen klant heeft.xlsm
	A	B
1	Naam klant:
2	Normen:
3
4	Output normen	ACS-002 Ind Lait, ACS-005 glaces-ijs, BVI/MPT Vleesverwerker,
5
6
7
8
9
10
11	ACS-002 Ind Lait
12
13	Klein bedrijf?	Duid aan
14	Ja
15	Nee
16
17	Dierenvoeders?	Duid aan
18	Ja
19	Nee
20
21	Aantal producttypes?	Duid aan
22	1
23	2
24	3
25	4 of meer
26
27	Producttypes?	Duid aan
28	UHT-consumptiemelkdranken en UHT- room
29	Gesteriliseerde consumptiemelkdranken en room
30	Gepasteuriseerde consumptiemelkdranken en room
31	Gefermenteerde melk
32	Thermisch behandelde gefermenteerde melk
33	Verse kaas
34	Harde kaas op basis van gepasteuriseerde melk
35	Mozzarella op basis van gepasteuriseerde melk
36	Zachte kaas op basis van gepasteuriseerde melk
37	Zure boter op basis van gepasteuriseerde melk, verse zure karnemelk, thermisch behandelde zure karnemelk
38	Melkpoeder
39	Neutrale desserts
40	Rauwmelkse kazen
41	Zure boter op basis van rauwe melk en verse zure karnemelk
42
43	ACS-005 glaces-ijs
44
45	Type Bedrijf?	Vul in
46	Valt het bedrijf onder versoepeling MB van 24/10/05?
47	Nevenstromen naar de diervoederindustrie?:
Data

Excel aanduiden welke normen klant heeft.xlsm
	A	B	C
1		Normen	TRUE
2	Distribution	ACS-003 Déb Vian	#VALUE!
3		ACS-007 Retail	#VALUE!
4		ACS-023 Horeca	#VALUE!
5		ACS-025 Collectiv	#VALUE!
6		ACS-026 boul distri	#VALUE!
7		ACS-041 Creche	#VALUE!
8		ACS-044 BtoC	#VALUE!
9	Feed	ACS-001	#VALUE!
10		ACS-010 Distribution	#VALUE!
11		ACS-010 Production	#VALUE!
12		ACS-038 Handel Agro	#VALUE!
13		Cahier végétal (BFA)	#VALUE!
14		FCA	#VALUE!
15		module I-01 Ovocom	#VALUE!
16		VLOG	#VALUE!
17	Food	ACS-002 Ind Lait	TRUE
18		ACS-004 Brasseries	#VALUE!
19		ACS-005 glaces-ijs	TRUE
20		ACS-006	#VALUE!
21		ACS-009 Tran/col Lait	#VALUE!
22		ACS-014 Fr et Lég	#VALUE!
23		ACS-017	#VALUE!
24		ACS-018	#VALUE!
25		ACS-019 Fenavian	#VALUE!
26		ACS-020 Meuneries	#VALUE!
27		ACS-022 Choprabisco	#VALUE!
28		ACS-024	#VALUE!
29		ACS-026 boul transfo	#VALUE!
30		ACS-027	#VALUE!
31		ACS-029	#VALUE!
32		ACS-032	#VALUE!
33		ACS-039	#VALUE!
34		Belplume Slachthuis	#VALUE!
35		Belplume Transport	#VALUE!
36		BePork Slachthuis	#VALUE!
37		BePork Uitsnijderij	#VALUE!
38		BePork Vleesverwerker	#VALUE!
39		BePork welfare	#VALUE!
40		BVI/MPT Slachthuis & Uitsnijderij	#VALUE!
41		BVI/MPT Vleesverwerker	TRUE
42		Colruyt	#VALUE!
43		Export - China	#VALUE!
44		Export Zuid-Korea Koelhuis	#VALUE!
45		Export Zuid-Korea Slachthuis	#VALUE!
46		Export Zuid-Korea Uitsnijderij	#VALUE!
47		Export Zuid-Korea Verwerking	#VALUE!
48		Febev + Groothandel	#VALUE!
49		Febev + Slachthuis voor runderen	#VALUE!
50		Febev + Slachthuis voor varkens	#VALUE!
51		Febev + Uitsnijderij voor runderen	#VALUE!
52		Febev + Uitsnijderij voor varkens	#VALUE!
53		GRMS	#VALUE!
54		SPECIFIC STANDARD	#VALUE!
55	ISACert	AOECS Module for Gluten Free Foods	N/A
56		ASDA-module	N/A
57		BLK	N/A
58		BRC Agents & Brokers	#VALUE!
59		BRC Packaging	#VALUE!
60		BRC S&D	#VALUE!
61		BRC v9	#VALUE!
62		FSMA Module Preventive Controls Preparedness	N/A
63		FSSC 22000 v5	#VALUE!
64		GFCP	N/A
65		Head Office	N/A
66		IFS Broker	#VALUE!
67		IFS Cash & Carry v2	#VALUE!
68		IFS Global Markets Food	#VALUE!
69		IFS L	#VALUE!
70		IFS v7	#VALUE!
71		IFS Wholesale v2	#VALUE!
72		Meat Supply Chain	N/A
73		Whole Sale-module	N/A
74	Suppliers FOOD	Aldi Australië	N/A
75		Barry Callebaut	N/A
76		Carrefour	N/A
77		Delhaize - PIA	N/A
78		Lidl	N/A
79		Lidl - Animal welfare	N/A
80		Puratos	N/A
81		Taste & Welfare audits - Belgian Porc Group	N/A
List

Cell Formulas
Range	Formula
C2:C54,C66:C71,C63,C58:C61	C2	=LOOKUP(1000,SEARCH(B2,Data!$B$4),List!$C$1)

Named Ranges
Name	Refers To	Cells
Output_Normen	=Data!$B$4	C66:C71, C58:C61, C2:C54, C63

 

[pjmorris]

try this:

If Sheets("List").Range("C17") = "TRUE" Then

 

[DarkSmile]

try this:

If Sheets("List").Range("C17") = "TRUE" Then

If I try to assign this to a button I get this;

 

[pjmorris]

hmmm, not sure. I've not seen that before, but it makes me think you've not saved the macro to a Macro Sheet - in the VBA editor you need to add a macro sheet to the project.

 

[DarkSmile]

hmmm, not sure. I've not seen that before, but it makes me think you've not saved the macro to a Macro Sheet - in the VBA editor you need to add a macro sheet to the project.

Don't know, this VBA works, it's just the check for "IF true then" that doesn't work it seems like.

Sub ACS002TEST()
  Sheets("ACS-002").Range("A2:B32").Copy Destination:=Sheets("Data").Range("A11")
End Sub

 

[pjmorris]

I haven't been able to recreate your error, but I did notice that you're missing an 'ENDIF' Statement. My version of the macro would be:

Sub ACS002()
    If Sheets("List").Range("C17") = True Then
        Sheets("ACS-002").Range("A2:B32").Copy Destination:=Sheets("Data").Range("A11")
    End If
End Sub

 

[DarkSmile]

I haven't been able to recreate your error, but I did notice that you're missing an 'ENDIF' Statement. My version of the macro would be:

Sub ACS002()
    If Sheets("List").Range("C17") = True Then
        Sheets("ACS-002").Range("A2:B32").Copy Destination:=Sheets("Data").Range("A11")
    End If
End Sub

Well, that was the whole issue it seems.. thank you !

 

[pjmorris]

thanks for the feedback - I like simple solutions

 

[DarkSmile]

thanks for the feedback - I like simple solutions

Small question (hopefully), are you able to help me with the second part?

What I would like to do is : Start a A11 , but if there is already data there then go to the last row (+1 so skip a row and paste in the one after that).

Sub ACS002T()
On Error GoTo eh
    If Sheets("List").Range("C17") = True Then
        Sheets("ACS-002").Range("A2:B32").Copy Destination:=Sheets("Data").Range("A11")
    End If
eh:
    Exit Sub
End Sub

 

[DarkSmile]

I was already able to get this to work, just need to skip one line before pasting

Sub Range_End_Method()
'Finds the last non-blank cell in a single row or column

Dim lRow As Long
Dim lCol As Long
    
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    If Sheets("List").Range("C19") = True Then
        Sheets("ACS-005").Range("A2:B6").Copy Destination:=Sheets("Data").Range("A" & lRow)
    End If
End Sub