Row filtering based on input box entry (column heading)

[Santed593]

I need help to create a vba code or macro to filter data based on inpu
box entry. In my worksheet I have 110 rows of Promo Titles. In eac
column (200 columns) are dollar sales goals of promo titles by Accoun
No. This means that the column headings are Account No. I would t
prompt the user using the input box to enter the Account No and th
macro will filter the dollar sales goals for all promo titles of tha
Account No. Once filtered I would like to copy and paste the info to
new worksheet. I have searched and read a lot of posting about dat
filtering but I can’t find anything about row filtering based on colum
input box entry. Any help is greatly appreciated. :confused

 

[Santed593]

I need help to create a vba code or macro to filter data based on inpu
box entry. In my worksheet I have 110 rows of Promo Titles. In eac
column (200 columns) are dollar sales goals of promo titles by Accoun
No. This means that the column headings are Account No. I would t
prompt the user using the input box to enter the Account No and th
macro will filter the dollar sales goals for all promo titles of tha
Account No. Once filtered I would like to copy and paste the info to
new worksheet. I have searched and read a lot of posting about dat
filtering but I can’t find anything about row filtering based on colum
input box entry. Any help is greatly appreciated.

Below is the code written:

Sub Filter_Cust()
strCriteria = InputBox("Enter Criteria")
If strCriteria = vbNullString Then Exit Sub

'Create a Worksheet with the customer name and copy over all data
Sheets("Distr").Select
Sheets("Distr").Copy Before:=Sheets(1)
Sheets("Distr (2)").Select
Sheets("Distr (2)").Name = strCriteria


Range("B1").Select

'Look for the customer data
Do Until ActiveCell.Value = ""
If Trim(ActiveCell.Value) = strCriteria Then
ActiveCell.Offset(0, 1).Range("A1").Select
Else
Selection.EntireColumn.Delete
End If
Loop

'Check to see if customer was found
If ActiveCell.Column = 2 Then
Sheets(strCriteria).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
MsgBox "Customer not found"
End If

End Sub

Any suggestion to cleanup the above code

 

[Art Farrell]

Hi,

I assumed you have Account No.1, Account No.2, etc., starting in Column B:

Option Explicit

Sub getAccount()
Dim acct As Long

Application.ScreenUpdating = False
Sheets("Distr").Activate
acct = Application.InputBox("Pick # for account", Type:=1)
If acct = False Then Exit Sub
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Account No."
& acct
Sheets("Distr").Activate
Range("A1").CurrentRegion.AutoFilter
Selection.AutoFilter Field:=1 + acct, Criteria1:="<>"
Union(Columns(1), Columns(1 + acct)).Select
Selection.Copy Sheets("Account No." & acct).Range("A1")
Selection.AutoFilter
Sheets("Account No." & acct).Select
End Sub

CHORDially,
Art Farrell

 

[Santed593]

Hi Art,

Thank you for your response. I tried the code but it is not working.
What I am trying to do is, if I enter the AcctNo. (5685) iit will
filter the data for that AcctNo. That means it will list down all the
rows with promo titles (Column A) and corresponding goals for that
account to a new worksheet. I am trying to attach an excel spreadsheet
but it will not allow me. Is it possible to email this to you so can
see the sample spreadsheet?

 

[Art Farrell]

Hi,

Sure- mail away.

(e-mail address removed)

CHORDially,
Art Farrell