CONFUSED_AS_USUAL
Board Regular
- Joined
- Jul 6, 2017
- Messages
- 59
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
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
