Macro Modification

[CONFUSED_AS_USUAL]

I am not well versed in VBA. Below was made for me a while back and works like a charm. However, I would like "Input Box" option removed and replaced with something I can just go into the code and modify the key word(s) myself as most of what I need moved is currently limited to the same 6 search criteria.

Thank you.

Sub DGB_REMOVE_TZ_QC()
'Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-29-17 1:00 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "DGP" 'Change sheet name here
Two = "TZANET710" 'Change sheet name here
Col = "13" ' Change Column to search here
Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
With Worksheets(One).Rows("1:" & Lastrow)
.AutoFilter
.AutoFilter field:=Col, Criteria1:=ans
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
' .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp


End With
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

 

[Joe4]

It is just as simple as replacing this line:

ans = InputBox("Enter value to search for")

with something like this:

ans = "Dog"

where you just type in whatever value you want to look for.

If you have a set of 6 words you are looking for that will always be the same, I would recommend storing them in an array, and then looping through the array.

 

[CONFUSED_AS_USUAL]

Hi Joe - Yes, that works well for 1. Unfortunately, I have no idea how to do an array of 6 different words. Any help would be appreciated.

 

[Joe4]

Maybe something like this:

Sub DGB_REMOVE_TZ_QC()
'Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-29-17 1:00 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
[COLOR=#ff0000]Dim ans As Variant
Dim i As Long[/COLOR]
    
[COLOR=#ff0000]ans = Array("Dog", "Cat", "Mouse", "Frog", "Toad", "Bear") ' 6 words to look for[/COLOR]
One = "DGP" 'Change sheet name here
Two = "TZANET710" 'Change sheet name here
Col = "13" ' Change Column to search here

Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1

[COLOR=#ff0000]For i = LBound(ans) To UBound(ans)[/COLOR]
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter field:=Col, Criteria1:=[COLOR=#ff0000]ans(i)[/COLOR]
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
'        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    End With
[COLOR=#ff0000]Next i
[/COLOR]
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub

 

[CONFUSED_AS_USUAL]

I locates and deletes all the words it is looking for. However, it is not transferring all of those records over to the "TZANET710" sheet. In the test I did, I put in 4 words that were in fact in the "DGP" sheet and left the "Toad" and "Bear" there as is. The last two were copied over - not the first two. Keep in mind that there can be more than 1 instance of the same word. Not sure if that makes a difference with your code.

Thks

 

[Joe4]

I did not analyze the rest of your code, I was just showing you how to apply an array.
I think the way that filtering is done might not work "as-is" with a loop (instead of just for one single value) without making some adjustments.
I will need some time to recreate the scenario with data. I should have some time to try to do that later on today.

 

[CONFUSED_AS_USUAL]

No rush Joe... and thank you for your time.

 

[Joe4]

OK. I think I kind of need to understand the original structure of your data, so I can try to re-create the same scenario.
Can you post some sample data, or at least let me know which columns you have populated?

 

[CONFUSED_AS_USUAL]

Joe,

I have about 30 columns populated. Here are the first 13. The "word" is being searched in the 13th column.

Here is a snippet.

COMM	Date	Doc Num	Item Code	Description	Quantity	Total	Price	Cost	Total Cost	% Gross Profit	Discount %	Code
ok	20171201	380724	xxx	xxx	72	113.04	1.57	0	0	1	-1	TZA710
ok	20171208	380729	xxx	xxx	1	9.9	9.9	0	0	1	10	BROCCA180
	20171202	380750	xxx	xxx	1	4	4	0	0	1	0	TZA710
	20171205	380754	xxx	xxx	2	1.2	0.6	0	0	1	0	IVEND17
	20171201	380757	xxx	xxx	2	61	30.5	0	0	1	0	PETINOS590
	20171204	380792	xxx	xxx	1	1.99	1.99	0	0	1	0	IVEND17
	20171208	380794	xxx	xxx	1	24.26	24.26	0	0	1	9.98	IVEND17
	20171130	380796	xxx	xxx	1	36.23	36.23	0	0	1	9.99	TIKIMING401
	20171130	380804	xxx	xxx	1	24.89	24.89	0	0	1	9.98	FORCIER435
	20171130	380815	xxx	xxx	1	1.08	1.08	0	0	1	10	IVEND17
	20171201	380815	xxx	xxx	1	0.68	0.68	0	0	1	9.33	IVEND17
	20171130	380815	xxx	xxx	1	2.25	2.25	0	0	1	10	IVEND17
	20171205	380830	xxx	xxx	3	22.5	7.5	0	0	1	0	IVEND17
	20171130	380849	xxx	xxx	1	6.75	6.75	0	0	1	10	IVEND17
	20171205	380861	xxx	xxx	1	1.76	1.76	0	0	1	9.74	BARBIES15
	20171205	380862	xxx	xxx	1	325	325	0	0	1	7.14	BOULANGERIE2180
	20171208	380878	xxx	xxx	12	5.88	0.49	0	0	1	0	IVEND17
paul	20171202	380880	xxx	xxx	1	7.16	7.16	0	0	1	9.94	IVEND17
	20171201	380881	xxx	xxx	1	90	90	0	0	1	0	IVEND17
	20171208	380885	xxx	xxx	3	7.47	2.49	0	0	1	0	IVEND17
	20171205	380888	xxx	xxx	4	52.2	13.05	0	0	1	10	SHERBROOKE5121
	20171202	380893	xxx	xxx	1	128.5	128.5	0	0	1	0	IVEND17
	20171201	380896	xxx	xxx	1	0.75	0.75	0	0	1	0	IVEND17
	20171207	380905	xxx	xxx	1	6.3	6.3	0	0	1	10	IVEND17
	20171130	380906	xxx	xxx	1	51.3	51.3	0	0	1	10	IVEND17
	20171201	380952	xxx	xxx	6	2.4	0.4	0	0	1	0	TZA710
mike ??	20171204	380957	xxx	xxx	10	28.3	2.83	0	0	1	0	TZA710
	20171202	380969	xxx	xxx	12	48	4	0	0	1	0	TZA710
	20171204	380975	xxx	xxx	1	10	10	0	0	1	0	TZA710
	20171207	380980	xxx	xxx	1	0.72	0.72	0	0	1	10	IVEND17
	20171204	380982	xxx	xxx	72	97.2	1.35	0	0	1	10	MIKES621
	20171207	380983	xxx	xxx	1	20.8	20.8	0	0	1	0	IVEND17
	20171207	380993	xxx	xxx	1	12	12	0	0	1	0	IVEND17
	20171207	380996	xxx	xxx	1	200	200	0	0	1	18.36	GRANDEROUE1250
	20171205	380997	xxx	xxx	2	8.9	4.45	0	0	1	0	IVEND17
	20171205	380717	xxx	xxx	496	2901.6	5.85	5.85	2901.6	0	0	TZA710
	20171202	38526	xxx	xxx	-288	-432	1.5	-0.89	256.32	1.59	0	resthotel1318
	20171207	380990	xxx	xxx	100	210	2.1	0.55	55	0.74	0	8710759CAN.INC.
ok	20171201	380925	xxx	xxx	240	300	1.25	0.95	228	0.24	0	ROMA8050
	20171207	380728	xxx	xxx	288	167.04	0.58	0.57	164.16	0.02	-1	TZA710
	20171130	380864	xxx	xxx	192	336.96	1.76	1.33	255.36	0.24	9.74	MARATHON3313
	20171208	380756	xxx	xxx	108	264.6	2.45	1.35	145.8	0.45	0	FOGO20820
	20171207	38534	xxx	xxx	-120	-612	5.1	-3.65	438	1.72	0	GRANDEROUE1250
	20171207	380743	xxx	xxx	100	495	4.95	3.11	311	0.37	13.91	SHERATON1201
	20171207	380990	xxx	xxx	72	788.4	10.95	5.1	367.2	0.53	0	8710759CAN.INC.
	20171207	380916	xxx	xxx	36	81	2.25	0.58	20.88	0.74	0	IVEND17
	20171204	380917	xxx	xxx	84	247.8	2.95	1.87	157.08	0.37	0	OTTAVIOS6880
	20171207	380990	xxx	xxx	71	688.7	9.7	5.72	406.12	0.41	0	8710759CAN.INC.
	20171208	380990	xxx	xxx	72	324	4.5	2.89	208.08	0.36	0	8710759CAN.INC.
	20171207	380990	xxx	xxx	72	644.4	8.95	5.83	419.76	0.35	0	8710759CAN.INC.
	20171205	380746	xxx	xxx	108	89.64	0.83	0.82	88.56	0.01	-1	TZA710
	20171208	380724	xxx	xxx	108	140.4	1.3	1.29	139.32	0.01	-1	TZA710
	20171202	380901	xxx	xxx	69	227.7	3.3	2.29	158.01	0.31	0	SAPORE4490
	20171207	380728	xxx	xxx	96	125.76	1.31	1.28	122.88	0.02	-1	TZA710
	20171201	380982	xxx	xxx	72	116.64	1.62	1.19	85.68	0.27	10	MIKES621
	20171202	380871	xxx	xxx	72	68.4	0.95	0.7	50.4	0.26	0	IVEND17
	20171130	380758	xxx	xxx	72	75.6	1.05	0.79	56.88	0.25	0	IVEND17
	20171207	380990	xxx	xxx	72	615.6	8.55	6.56	472.32	0.23	0	8710759CAN.INC.
	20171208	380917	xxx	xxx	72	212.4	2.95	2.33	167.76	0.21	0	OTTAVIOS6880
	20171130	380990	xxx	xxx	60	330	5.5	3.65	219	0.34	0	8710759CAN.INC.
	20171201	38528	xxx	xxx	-48	-237.6	4.95	-2.67	128.16	1.54	0	SCAROLIES950
	20171130	380746	xxx	xxx	84	197.4	2.35	2.23	187.32	0.05	-1	TZA710
	20171205	380782	xxx	xxx	24	40.56	1.69	0.46	11.04	0.73	0	ALEXANDRE518
	20171205	380863	xxx	xxx	24	40.56	1.69	0.46	11.04	0.73	0	Daou 519
	20171201	380990	xxx	xxx	50	122.5	2.45	1.39	69.5	0.43	0	8710759CAN.INC.
	20171201	380972	xxx	xxx	36	72	2	0.82	29.52	0.59	0	playground1500
	20171201	380761	xxx	xxx	48	429.84	8.96	5.65	271.2	0.37	9.95	MARCHEBK4245
	20171202	381013	xxx	xxx	48	309.6	6.45	4.2	201.6	0.35	4.44	KAMPAI1616
	20171207	380843	xxx	xxx	48	88.8	1.85	1.21	58.08	0.35	0	IVEND17
	20171205	38531	xxx	xxx	-48	-88.8	1.85	-1.21	58.08	1.65	0	BARBIES70
	20171201	380728	xxx	xxx	72	51.08	0.55	0.7	50.4	0.01	0	TZA710
	20171201	380728	xxx	xxx	72	32.4	0.45	0.45	32.4	0	0	TZA710
	20171208	380916	xxx	xxx	36	66.6	1.85	0.93	33.48	0.5	0	IVEND17
	20171201	380782	xxx	xxx	36	41.4	1.15	0.6	21.6	0.48	0	ALEXANDRE518
	20171201	380728	xxx	xxx	68	39.44	0.58	0.58	39.44	0	0	TZA710
	20171205	380808	xxx	xxx	40	70	1.75	1.05	42	0.4	0	IVEND17
	20171205	380812	xxx	xxx	36	71.64	1.99	1.08	38.88	0.46	0	barbie7850
	20171201	380990	xxx	xxx	48	516.48	10.76	7.88	378.24	0.27	10	8710759CAN.INC.
	20171202	380736	xxx	xxx	24	63.72	2.66	0.98	23.52	0.63	9.83	ROS1000
	20171207	380898	xxx	xxx	48	81.12	1.69	1.29	61.92	0.24	0	IVEND17
	20171208	381013	xxx	xxx	48	324	6.75	5.18	248.64	0.23	0	KAMPAI1616
	20171208	381013	xxx	xxx	48	309.6	6.45	5.18	248.64	0.2	4.44	KAMPAI1616
	20171207	380990	xxx	xxx	30	255	8.5	4.46	133.8	0.48	0	8710759CAN.INC.
	20171207	381013	xxx	xxx	45	290.25	6.45	5.18	233.1	0.2	4.44	KAMPAI1616
	20171201	380756	xxx	xxx	36	32.4	0.9	0.59	21.24	0.34	10	FOGO20820
	20171202	380990	xxx	xxx	30	510	17	9.48	284.4	0.44	0	8710759CAN.INC.
	20171207	380861	xxx	xxx	18	26.73	1.49	0.5	9	0.66	9.7	BARBIES15
	20171201	380831	xxx	xxx	3	29.85	9.95	0.57	1.71	0.94	0	IVEND17
	20171201	380882	xxx	xxx	24	27	1.13	0.53	12.72	0.53	9.6	IVEND17
	20171204	380738	xxx	xxx	36	114.84	3.19	2.32	83.52	0.27	0	IVEND17
	20171207	380969	xxx	xxx	48	174.61	2.82	3.54	169.92	0.03	0	TZA710
	20171207	380746	xxx	xxx	48	122.88	2.56	2.5	120	0.02	-2.5	TZA710
	20171207	380765	xxx	xxx	2	0.98	0.49	0.02	0.04	0.96	0	IVEND17
	20171204	380724	xxx	xxx	48	94.56	1.97	1.95	93.6	0.01	-1	TZA710
	20171205	380724	xxx	xxx	48	62.88	1.31	1.3	62.4	0.01	-1	TZA710
	20171205	380724	xxx	xxx	48	62.88	1.31	1.3	62.4	0.01	-1	TZA710
	20171205	380782	xxx	xxx	36	106.2	2.95	2.2	79.2	0.25	0	ALEXANDRE518
	20171207	380740	xxx	xxx	48	52.8	1.1	1.1	52.8	0	0	TZA710
	20171208	380969	xxx	xxx	48	72.96	1.52	1.52	72.96	0	0	TZA710
	20171130	380978	xxx	xxx	24	39.84	1.66	0.83	19.92	0.5	0	LECOING8297
	20171201	380718	xxx	xxx	24	107.04	4.46	2.25	54	0.5	10	MONZA1197
	20171207	380827	xxx	xxx	36	72	2	1.59	57.24	0.21	0	BARBIES70
	20171130	380986	xxx	xxx	12	9.84	0.82	0.22	2.64	0.73	0	IVEND17
	20171207	380771	xxx	xxx	10	42.75	4.28	0.97	9.7	0.77	9.9	DEUX92
	20171207	380932	xxx	xxx	30	121.23	4.04	2.85	85.5	0.29	10.02	IVEND17
	20171202	380719	xxx	xxx	36	210.6	5.85	4.96	178.56	0.15	10	NARCISSE93
	20171207	380756	xxx	xxx	32	37.44	1.17	0.9	28.8	0.23	10	FOGO20820
	20171205	380811	xxx	xxx	24	141.36	5.89	3.47	83.28	0.41	0	HOPKINS5626
	20171204	380850	xxx	xxx	20	135	6.75	3.33	66.6	0.51	10	ELIXOR3237
	20171207	380880	xxx	xxx	20	15.3	0.77	0.38	7.6	0.5	9.41	IVEND17

<colgroup><col width="92" span="2" style="width:69pt"> <col width="92" span="11" style="width:69pt"> </colgroup><tbody>
</tbody>

 

[Joe4]

OK, I see the problem. Since the last row on sheet 2 keeps growing as we add data to it, we need to recalculate that value with every iteration of our loop.
So I just moved that line inside the loop, i.e.

Sub DGB_REMOVE_TZ_QC()
'Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-29-17 1:00 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
Dim ans As Variant
Dim i As Long
    
ans = Array("TZA710", "IVEND17", "BARBIES15", "Frog", "Toad", "Bear") ' 6 words to look for
One = "DGP" 'Change sheet name here
Two = "TZANET710" 'Change sheet name here
Col = "13" ' Change Column to search here

Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row

For i = LBound(ans) To UBound(ans)
    Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter field:=Col, Criteria1:=ans(i)
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
'        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    End With
Next i

ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub