Can you please advise how I can fix the following codes so that they do not class with each anymore. I apologise that I had to put down a lot of codes here but I really have no idea which of those are making them clash with each other.
So, I have this part to return "Rollup" for any empty Sales and Production cells if "Shipped" in Column AU (47th column).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim counter As Long
Dim lastcolumn As Long
lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
'Shipped without Title Transfer
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
For counter = 1 To lastColumn
If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") _
And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
Me.Cells(Target.Row, counter).Value = "Rollup"
End If
Next counter
End If
Then I have this piece to return "x" in column AX (50th column) if the last Sales column has "Title Transfer".
Dim r As Range, r1 As Range, counter As Long
Dim MaxCol As Variant, rg As Range, j As Long
If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(Target.Column).Resize(, 3))
Call DoCells(r)
End If
'Automatically put "x" if Title Transfer in any Sales columns
If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
If Target.CountLarge > 1 Then Exit Sub
Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
MaxCol = 0
For j = Columns("AP").Column To Columns("N").Column Step -4
If Cells(Target.Row, j) <> "" Then
If j > MaxCol Then MaxCol = j
End If
Next
If MaxCol Mod 4 = 2 Then
If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
Cells(Target.Row, 50).Value = "x"
Else
Cells(Target.Row, 50).Value = ""
End If
End If
End If
'This I have 8 Sales Column, however, I only put 1 line down for demonstration
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
If Not r Is Nothing Then Call DoCells(r)
If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
If Target.CountLarge > 1 Then Exit Sub
Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
MaxCol = Evaluate("=MAX(IF(" & rg.Address & "<>"""",COLUMN(" & rg.Address & ")))")
If MaxCol Mod 4 = 2 Then
If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
Cells(Target.Row, 50).Value = "x"
Else
Cells(Target.Row, 50).Value = ""
End If
End If
End If
End Sub
Here is the DoCells sub that one of the lines calls up.
Private Sub DoCells(r As Range)
Dim r1 As Range
For Each r1 In r.Cells
With r1
Select Case .Column
Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
Call MasterChange(.Resize(1, 3))
Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
Call MasterChange(.Offset(0, -1).Resize(1, 3))
Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
Call MasterChange(.Offset(0, -2).Resize(1, 3))
End Select
End With
Next
End Sub
Here is my data structure using Markdown Table:
| Title | Engine Family | Market Segment | Customer | Engine Model | S/N | Build Spec | ACTL.FINISH | Sales Order | Item | Committed Date | EPS Date | Target | Sales | Production | Day 1 | Status | Sales | Production | Day 2 | Status | Sales | Production | Day 3 | Status | Sales | Production | Day 4 | Status | Sales | Production | Day 5 | Status | Sales | Production | Day 6 | Status | Sales | Production | Day 7 | Status | Sales | Production | Day 8 | Status | Comments | MB51 Shipped | FPS? | Plant | Title Transfer |
|--------|---------------|----------------|----------|--------------|-----|------------|-------------|-------------|------|----------------|------------|--------|-------|------------|-------|--------|----------------|------------|----------------|--------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|----------|--------------|------|-------|----------------|
| Rollup | PS | APU | ABC | 46C12 | 1 | BS1 | 0000-00-00 | 101 | 450 | 2019-12-31 | 2019-12-31 | Rollup | Green | Rollup | Green | Sales | Title Transfer | Yellow | Title Transfer | Sales | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | | x |
| Yellow | PS | FEP | ADG | PS3 | 3 | BS3 | 0000-00-00 | 103 | 180 | 2019-12-16 | 2019-12-20 | Yellow | Green | Rollup | Green | Sales | Title Transfer | Yellow | Title Transfer | Sales | Rollup | Rollup | Rollup | Sales/Production | Rollup | Rollup | Rollup | Sales/Production | Rollup | Rollup | Rollup | Sales/Production | Rollup | Rollup | Rollup | Sales/Production | Rollup | Rollup | Rollup | Sales/Production | Rollup | Rollup | Rollup | Sales/Production | | Shipped | | | |
| Rollup | T6T | OEM | FEDS | 67C | 5 | BS5 | 0000-00-00 | 105 | 250 | 2019-12-23 | 2019-12-22 | Rollup | Green | Rollup | Green | Sales | Title Transfer | Yellow | Title Transfer | Sales | Shipped | Rollup | Shipped | Sales/Production | Shipped | Rollup | Shipped | Sales/Production | Shipped | Rollup | Shipped | Sales/Production | Shipped | Rollup | Shipped | Sales/Production | Shipped | Rollup | Shipped | Sales/Production | Shipped | Rollup | Shipped | Sales/Production | | Shipped | | | x |
FYI, I have 8 Days in total, each Day is a combination of 4 columns with the exact same order: Sales, Production, Day, Status. The range is from column N to column BS (or AS in an actual Excel workbook).
As seen from the table:
1) the 1st row did exactly what I wanted. It did evaluate correctly the "Title Transfer" in column Sales/column R (of Day 2) to be the last Sales column that has "Title Transfer" and return an "x" in column BX (or column AX in my excel file).
2) the 2nd row, the codes returned both correct and wrong results.
I had put "Title Transfer" in a Sales column first, which the Macro then returned an "x" in column BX. That's correct.
However, when I put "Shipped" in column BU after having put "Title Transfer" first in column BX, the "x" was replaced by the Shipped codes I posted above. It did return "Rollup" for all empty Sales and Production cells when I put "Shipped" in column BU (47th column or column AU in my excel file). But the "x" to indicate Title Transfer was gone.
So here comes the problem I've been struggling with for the past week. Can you please advise how I can fix this problem?
3) the 3rd row is what I wanted my codes did if both "Shipped" in column BU and "x" in column BX (apparently it won't work)
To be short, my codes should have done the following:
1) If "Shipped" in column BU (AU in an actual Excel file) and no "x" in column BX (AX in an actual Excel file), then return "Rollup" for all empty Sales and Production cells
2) If "Title Transfer" in the last Sales column and no "Shipped" in column BU (AU in an actual Excel file), return "x" in column BX (AX in an actual Excel file)
3) If "Title Transfer" in the last Sales column (has to happen first) and "Shipped" in column BU (happens later) (AU in an actual Excel file), return "x" in column BX and "Shipped" in all empty Sales and Production cells
Can you please help how to get it to work that way? Thanks a lot and please let me know if you need more info.
Ps: This is what MasterChange has:
Public Sub MasterChange(SPD As Range)
Dim rSales As Range
Dim rProduction As Range
Dim rDay As Range
Set rSales = SPD.Cells(1, 1)
Set rProduction = SPD.Cells(1, 2)
Set rDay = SPD.Cells(1, 3)
Application.EnableEvents = False
If rSales = "Rollup" And rProduction = "Rollup" Then
rDay = "Rollup"
ElseIf rSales = "Rollup" And rProduction = "Green" Then
rDay = "Green"
ElseIf rSales = "Rollup" And rProduction = "Yellow" Then
rDay = "Yellow"
'I have approximately 40 Ifs statements like those but above are just a few for demonstration
End If
Application.EnableEvents = True
End Sub
Related
I am needing to transpose only a few columns (ex: C:G) into a single column, while maintaining the information in Column A and B.
So if Joe made a sale on Monday Then "Monday" would be in the new Day Column. Then the next row would have Joe again, but this time "Wednesday" in the Day Column. Then, if there are no more values, then move to Steve and do the same thing. I have been stuck on this for a very long time so any advice or new approaches to this would be greatly appreciated. I don't care if it's with a formula or VBA code.
| | A | B | C | D | E | F | G |
+---+-------+-------+--------+---------+-----------+----------+--------+
| 1 | Names | Sales | Monday | Tuesday | Wednesday | Thurday | Friday |
| 2 | Joe | 24500 | Monday | | Wednesday | | |
| 3 | Steve | 15454 | | Tuesday | | | |
| 4 | Emily | 58421 | | Tuesday | Wednesday | Thursday | |
| 5 | Marie | 24582 | Monday | | | | Friday |
+---+-------+-------+--------+---------+-----------+----------+--------+
+---+-------+-------+-----------+
| | A | B | C |
+---+-------+-------+-----------+
| 1 | Names | Sales | Day |
| 2 | Joe | 24500 | Monday |
| 3 | Joe | 24500 | Wednesday |
| 4 | Steve | 15454 | Tuesday |
| 5 | Emily | 58421 | Tuesday |
| 6 | Emily | 58421 | Wednesday |
| 7 | Emily | 58421 | Thursday |
| 8 | Marie | 24582 | Monday |
| 9 | Marie | 24582 | Friday |
+---+-------+-------+-----------+
Wanted to test the new LET() function.
If one has LET() in Office 365 (as of this writing only available to certain insiders)
Put this in the first cell of the output and Excel will spill the results:
=LET(RNG_1,A2:INDEX(A:A,MATCH("zzz",A:A)),RNG_2,B2:INDEX(B:B,MATCH("zzz",A:A)),RNG_3,C2:INDEX(G:G,MATCH("zzz",A:A)),RW,ROWS(RNG_3),CLM,COLUMNS(RNG_3),SEQ,SEQUENCE(RW*CLM,,0),TOT,CHOOSE({1,2,3},INDEX(RNG_1,INT(SEQ/CLM)+1),INDEX(RNG_2,INT(SEQ/CLM)+1),INDEX(RNG_3,INT(SEQ/CLM)+1,MOD(SEQ,CLM)+1)&""),FILTER(TOT,INDEX(TOT,0,3)<>""))
'VBA Macro solution
Sub Transps()
Range("l2:n100").ClearContents
LstRw = Application.WorksheetFunction.CountA(Range("a:a"))
writeRw = 2
For rw = 2 To LstRw
For col = 3 To 7
If Not IsEmpty(Cells(rw, col)) Then
Cells(writeRw, 12) = Cells(rw, 1)
Cells(writeRw, 13) = Cells(rw, 2)
Cells(writeRw, 14) = Cells(rw, col)
writeRw = writeRw + 1
End If
Next col
Next rw
End Sub
Just to offer a further solution based on Office 365 I demonstrate a VBA approach using â–ºWorksheetfunction.Filter() to write transposed blocks of weekday data back to any target:
Sub UnpivotWeekdays()
Dim DataRange As Range
Set DataRange = Sheet1.Range("A2:G6") ' << change to your needs referring to a sheet's Code(Name)
With Sheet2.Range("A2") ' << change to any wanted target cell
Dim i As Long, ii As Long
For i = 1 To DataRange.Rows.Count
'get data blocks resized to 1..5 rows (here: Monday..Friday)
Dim commoninfo: commoninfo = getCommonInfo(DataRange, i)
Dim weekdays: weekdays = getWeekdays(DataRange, i)
Dim cnt As Long: cnt = UBound(weekdays)
'write identical common data to first two columns
.Offset(ii).Resize(cnt, 2).Value = commoninfo
'write weekdays to single column
.Offset(ii, 2).Resize(cnt, 1) = Application.Transpose(weekdays)
'increment current target offsets
ii = ii + cnt
Next
End With
End Sub
Help functions
The help function getWeekdays() uses Worksheetfunction.Filter() and returns a "flat" array of non-empty findings which will be transposed to vertical entries in the calling procedure:
Function getWeekdays(rng As Range, ByVal myRow As Long, Optional startColumn As Long = 3) As Variant()
'Purpose: filter valid weekdays (i.e. return only cells <> "")
'Note : assuming day data in 3rd range column (defaulting startColumn = 3)
Const DaysOfWeek = 5 ' here: Monday .. Friday
Dim ad As String: ad = rng.Offset(0, startColumn).Resize(1, DaysOfWeek).Rows(myRow).Address
On Error Resume Next
getWeekdays = Evaluate("Filter(" & ad & ", " & ad & "<>"""")")
If Err.Number <> 0 Then GoTo NOENTRIES
Exit Function
NOENTRIES:
Dim tmp: ReDim tmp(1 To 1)
getWeekdays = tmp
End Function
The function getCommonInfo() returns an array of the identifying data in the first two columns to be repeated as often as there exist weekday entries:
Function getCommonInfo(rng As Range, ByVal myRow As Long) As Variant()
'Purpose: get common info from first two range columns
getCommonInfo = rng.Offset(myRow - 1).Resize(1, 2).Value
End Function
My spreadsheet continuously refreshes data contained in the table based on a project number. There are 5 additional columns that contain manually inputted information (i.e. does not automatically refresh) associated with each project number. These columns essentially contain user comments and must stay associated with the project number through each refresh. When a refresh occurs, new project numbers may also be added to the list.
I am looking for a solution to store these 5 manually inputted columns with the project number.
Previously, we used a dictionary when only one key-value pairing was required. However, now we have multiple values for each key.
Public Function saveComments(rowOfCom As Integer, _
rowOfSafety As Integer, _
rowOfCompliance As Integer, _
rowOfCommercial As Integer, _
rowOfOperational As Integer, _
rowOfSIssue As Integer, _
ws As Worksheet) As Variant
'Sub is meant to save comments associated with masterplan id's
'We do this by first making one dictionary with every plan year and another
' dictionary that will store the mpids & comments
'Idea is to loop through each ws, store each mpid and comment then run macro
' to update mpids then paste in new comments
Dim mpDict As New Scripting.Dictionary
Dim numOfWS As Integer, count As Integer, rowCount As Integer, i As Integer
Dim rg As Range
Dim Key As Variant
Dim value As Variant
'Get the number of mpDictionaries needed. Counts the sheets if its a year
' or Not set just in case a sheet is added
With ws
rowCount = .Range("A1").End(xlDown).Row
For i = 2 To rowCount
If mpDict.Exists(.Cells(i, 1).value) = False Then
For j = 13 To j = 18
'Access the mpDict and store the MPID and Comment
mpDict.Add .Cells(i, 1).value, .Cells(i, j).value
Next j
End If
Next i
' Debug.Print (yearDict.Item(ws.Name).Item(.Cells(2, 1).value))
count = count + 1
End With
Set saveComments = mpDict
End Function
What I do in this case is to build a compound entry for each key. This can be in the form of a Class object, another Dictionary, a Collection or almost anything. For the simplest of situations though, I just create a CSV list.
For example, if my data is
+--------+----+
| red | 42 |
| green | 36 |
| blue | 49 |
| white | 44 |
| orange | 25 |
| black | 45 |
| purple | 32 |
| mauve | 41 |
| cherry | 14 |
| lemon | 32 |
| lime | 6 |
| red | 11 |
| green | 17 |
| blue | 13 |
| white | 9 |
| orange | 23 |
| black | 21 |
| purple | 38 |
| mauve | 19 |
| cherry | 22 |
| lemon | 42 |
| lime | 48 |
| red | 35 |
| green | 37 |
| blue | 44 |
| white | 6 |
| orange | 41 |
| black | 5 |
| purple | 15 |
| mauve | 20 |
+--------+----+
Then I'll build a using code similar to
Option Explicit
Sub BuildDictionaryExample()
Dim myDict As Dictionary
Set myDict = New Dictionary
Dim myData As Range
Set myData = Sheet1.Range("A1:B30")
Dim keyValue As Variant
Dim thisRow As Range
For Each thisRow In myData.Rows
keyValue = thisRow.Cells(1, 1)
If Not myDict.Exists(keyValue) Then
myDict.Add keyValue, thisRow.Cells(1, 2)
Else
Dim newValue As Variant
newValue = myDict(keyValue) & "," & thisRow.Cells(1, 2)
myDict(keyValue) = newValue
End If
Next thisRow
End Sub
I'm still new to VBA and I'm running a report and the way I receive it a few of the rows have an additional column of data that I don't need but it messes up formatting for those entries. For example, in Column B I have the profiles listed for everyone but for these few entries I have a number or something else (it isn't consistent for each one). But for those same entries I have a "Y" in Column H that none of the other entries have. I'm trying to search through the report for the "Y" in Column H and then copy columns C through H and paste it in Column B so that all the data aligns. Out of a couple hundred entries there might be 6-7 that need to be moved. Here is some sample data that I hope shows the issue. BTHOMAS Column B is the problem in this example.
A | B | C | D | E | F | G | H
--------------------------------------------------------------------------------------------
ID | PROFILE | STATUS | DATE ADDED | LAST USED | EXP DATE | P/W EXP |
SBUTLER | NOM | ENABLED | 9/9/2014 | 10/5/2018 | 00/00/00 | N |
WPERRY | NOM | ENABLED | 10/29/2014 | 10/4/2018 | 00/00/00 | N |
BTHOMAS | 1234 | NOM | ENABLED | 2/1/2017 | 9/28/2018 | 00/00/00 | Y
I've done a lot of research on copy and paste macros, but everything I have found is either a single cell or the entire row and they paste it to another sheet. I just want to copy and paste in the same row. Here is the code I have so far, unfortunately it moves every column.
Sub MoveColumns()
LR = Cells(Rows.Count, "B").End(xlUp).Row
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
Range("C:H").copy Range("B:G")
End If
Next
End Sub
The expected result is for the report to be aligned like in the example below. There is data in columns I through J so I can only copy columns C through H. Thanks for your time.
A | B | C | D | E | F | G | H
--------------------------------------------------------------------------------------------
ID | PROFILE | STATUS | DATE ADDED | LAST USED | EXP DATE | P/W EXP |
SBUTLER | NOM | ENABLED | 9/9/2014 | 10/5/2018 | 00/00/00 | N |
WPERRY | NOM | ENABLED | 10/29/2014 | 10/4/2018 | 00/00/00 | N |
BTHOMAS | NOM | ENABLED | 2/1/2017 | 9/28/2018 | 00/00/00 | Y
You need to copy only the lines for which the condition returns true. Try:
If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
Worksheets("Sheet1").Range("C" & i & ":H" & i).copy Worksheets("Sheet1").Range("B" & i & ":G" & i)
End If
An alternative: you can delete cell in column C, shifting the others towards the left:
If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
Worksheets("Sheet1").Range("C" & i).Delete Shift:=xlToLeft
End If
or
If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
Worksheets("Sheet1").Cells(i, 3).Delete Shift:=xlToLeft
End If
(note that this will shift all cells on a given row and may result in something you don't want)
This is a follow up to my previous question (Retrieving information of OLEObjects from Workbook with VBA)
Scenario: I am trying to retrieve data from a worksheet. The data might be normal strings or number or might be encased in check boxed (checked or not).
Data example:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | checkbox for rfd | nfd | checkbox for nfd |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Obs: In this example the "checkbox for rfd/nfd" is a normal checkbox (either form or activex), and depending on the item in that sheet, either might be selected.
Objective: What I am trying to do is read the worksheet in 2 steps: First read all the data that is directly called, so I use the code:
Sub Test_retrieve()
' this will get all non object values from the sheet
Dim array_test As Variant
Dim i As Long, j As Long
array_test = ThisWorkbook.Sheets(1).UsedRange
For i = 1 To ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
ThisWorkbook.Sheets(2).Cells(i, j) = array_test(i, j)
Next j
Next i
End Sub
to get:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | | nfd | |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Next I am trying to reach all the objectives/shapes in my worksheet. I used the following code to get name, value (checked of not) and location of all activex objects:
Sub getavticeboxvalue()
' this will get the names and values (as binary) of all the activex controlbox objects in the sheet
Dim objx As Object
Dim i As Long
i = 1
For Each objx In ThisWorkbook.Sheets(1).OLEObjects
If objx.Object.Value = True Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 1
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
ElseIf objx.Object.Value = False Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 0
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
End If
i = i + 1
Next objx
End Sub
Which yields something like:
+-------+-----------+----------+
| value | name | location |
+-------+-----------+----------+
| 0 | checkbox1 | $C$2 |
+-------+-----------+----------+
| 1 | checkbox2 | $E$2 |
+-------+-----------+----------+
I would then proceed to feed the values (1s and 0s), to the first table, in the place where the checkboxes originally where (location).
Issue: When I try the same procedure for Form Control (instead of activex), I have less options, and although I can look for them (ThisWorkbook.Sheets(1).Shapes.Type = 8) I cannot find their name or location.
Question: Is there a way to find their name and location? Is there a more efficient way to reach the result?
Objective:
+---------+-------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+
| value x | rfd | 0 | nfd | 1 |
+---------+-------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+
I have a table of data, and some of the data is garbage. There's about 30000 entries sorted by unit. I only care about 20 of those units. I can easily sort the data by applying a filter, but it's tedious to click the 23 or so times and I'm going to have to manage this report weekly.
I've captured the relevant criteria into a different sheet, all non-repeating values sorted into a column. I'd like to arrange another sheet so that it only displays the rows from my table if the data in their unit column matches the criteria column.
I know I need to use VLOOKUP... somehow, but I haven't stumbled across any tutorials that compare a cell's value to a table.
In case that was all very confusing:
My table:
Action | Job Desc | Dept
XFR | IT Guy | Home Office 1
POS | Security Guy| Satellite Office
TTL | Analyst Guy | Home Office 2
I want to have a new sheet that only contains 3 rows:
Action | Job Desc | Dept
XFR | IT Guy | Home Office 1
TTL | Analyst Guy | Home Office 2
I have the values "Home Office 1" and "Home Office 2" stored elsewhere (there are actually 28 different office values). How do I build this sheet so it only displays these values - similar to the stock Excel filter function?
I think the easiest way to do this is by creating a tab of "interesting" units and vlookup to this. In the new interesting tab you would list the 20 items you are interested in column A.
In the data tab with all 30,000 rows you need to add a new column to check each row if it exists in the interesting tab. I assume the units are in column C and you are entering this formula in cell D1 =NOT(ISERROR(VLOOKUP(C1,InterestingTab!A:A,1,0))).
The result of the formula is TRUE or FALSE, which can easily be filtered on. Then you can easily add new items to the interesting tab and it will update automatically.
A very common question.
Assuming that:
1) You are using Excel 2010 or later
2) The original table is in Sheet1!A1:C10 (with headers in row 1)
3) The table to house the (filtered) results is in Sheet2 and of an identical layout to the original table
4) The list of (28) criteria is in Sheet3!A2:A29
then enter this single formula in Sheet2!J1:
=SUMPRODUCT(COUNTIF(Sheet3!A2:A29,Sheet1!C2:C10))
Of course, the choice of cell here does not have to be J1, though, whatever you choose, make sure that it is a cell which is external to your results table. This formula is a one-off, and, unlike those in the main results table, NOT designed to be copied to any further cells; it simply determines the number of expected returns, and will be referenced in the main table formulas, thus avoiding resource-heavy IFERROR set-ups.
The formula in cell A2 of the results table is then:
=IF(ROWS($1:1)>$J$1,"",INDEX(Sheet1!A:A,AGGREGATE(15,6,ROW(Sheet1!B$2:B$10)/MATCH(Sheet1!$C$2:$C$10,Sheet3!$A$2:$A$29,0)^0,ROWS($1:1))))
and copied down and to the right as required.
Obviously if the upper row reference in your original table is not actually 10 then you will need to amend that part within these formulas accordingly. However, be sure not to choose an arbitrarily large value, since, for each additional cell referenced, extra calculation will be required (and that applies whether those additional cells are technically beyond the last-used cells in those ranges or not.)
As such, I recommend that you either choose a suitably low, though sufficient, upper bound for the end row being referenced or, even better, make your ranges dynamic, such that they automatically adjust as your data expands/contracts.
Regards
Here is my anser...
Sub takeMyValus()
Dim r1
Dim r2
Dim c
Dim rng1 As Range
Dim rng2 As Range
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim List()
Dim i
Dim j
r1 = Range("A1").End(xlDown).Row 'to know the last row
c = Range("A1").End(xlToRight).Column 'to know the last colum
Set sht1 = Sheets("Data") 'this is the name I used, but you
'put the name of your data sheet
Set sht2 = Sheets("List") 'the sheet with the sorted list of the data you want
sht1.Activate 'Just in case
Set rng1 = Range(Cells(1, 1), Cells(r1, c)) 'set just the range with data
rng1.AutoFilter 'set the autofilter
'is better if the data has no autofilter
'when you begin to run the macro
sht2.Activate
'imagine that you got the list in column A and is just 5 items in your data
'With no header
'+---------+
'| Office3 |
'| Home5 |
'| Office8 |
'| Home8 |
'| Sat2 |
'+---------+
'List for my example...
r2 = Range("A1").End(xlDown).Row 'to know the total item on the list
'in this case will be 5
Set rng2 = Range(Cells(1, 1), Cells(r2, 1)) 'set the range of the list
'that is Range("A1:A5")
j = 0 'ini the counter
For Each i In rng2 'for every cell in Range("A1:A5")
j = j + 1 'increase the j to 1 every time
ReDim Preserve List(1 To j)
'redimension the var...
List(j) = i.Value 'store every cell (just the data) into an array
Next i 'next one.
sht1.Activate 'go to sheet with all the data
rng1.AutoFilter Field:=3, Criteria1:=Array(List), Operator:=xlFilterValues 'set the filter with the list
rng1.SpecialCells(xlCellTypeVisible).Copy 'copy just the cells that you can see, this is the filter
Sheets.Add after:=Sheets(Sheets.Count) 'add a new sheet
ActiveSheet.Name = myTime 'put a diferent name, see the function below
Set sht3 = ActiveSheet 'store the new sheet into this var
sht3.Activate 'go to the new sheet... is already activate, but just in case...
Range("A1").PasteSpecial xlPasteAll 'paste all in Range("A1")
Application.CutCopyMode = False 'is like press ESCAPE in the keyboard
End Sub
Function myTime() As String 'the function a told you
Dim HH
Dim MM
Dim SS
Dim TT
HH = Hour(Now)
MM = Minute(Now)
SS = Second(Now)
myTime = Format(HH, "00") & Format(MM, "00") & Format(SS, "00")
End Function
Here is the example of my data...
+--------+---------+----------+
| Action | Job Des | Dept |
+--------+---------+----------+
| XFR | IT | Office1 |
| POS | Sec | Office2 |
| TTL | Analyst | Office3 |
| XFR | IT | Office4 |
| POS | Sec | Office5 |
| TTL | Analyst | Office6 |
| XFR | IT | Office7 |
| POS | Sec | Office8 |
| TTL | Analyst | Office9 |
| XFR | IT | Office10 |
| POS | Sec | Home1 |
| TTL | Analyst | Home2 |
| XFR | IT | Home3 |
| POS | Sec | Home4 |
| TTL | Analyst | Home5 |
| XFR | IT | Home6 |
| POS | Sec | Home7 |
| TTL | Analyst | Home8 |
| XFR | IT | Home9 |
| POS | Sec | Home10 |
| TTL | Analyst | Home11 |
| XFR | IT | Home12 |
| POS | Sec | Sat1 |
| TTL | Analyst | Sat2 |
| XFR | IT | Sat3 |
| POS | Sec | Sat4 |
| TTL | Analyst | Sat5 |
| XFR | IT | Sat6 |
| POS | Sec | Sat7 |
| TTL | Analyst | Sat8 |
| XFR | IT | Sat9 |
| POS | Sec | Sat10 |
| TTL | Analyst | Sat11 |
| XFR | IT | Sat12 |
| POS | Sec | Sat13 |
| TTL | Analyst | Sat14 |
+--------+---------+----------+
The list
+---------+
| Office3 |
| Home5 |
| Office8 |
| Home8 |
| Sat2 |
+---------+
The result:
+--------+---------+---------+
| Action | Job Des | Dept |
+--------+---------+---------+
| TTL | Analyst | Office3 |
| POS | Sec | Office8 |
| TTL | Analyst | Home5 |
| TTL | Analyst | Home8 |
| TTL | Analyst | Sat2 |
+--------+---------+---------+