ExcelBanter - View Single Post

Ron Rosenfeld[_2_]

On Fri, 15 Nov 2013 14:40:44 GMT, wrote:

Hi,

I hope someone can help with a solution to this problem.
I don't know if a macro is required or it can be done in another way.
Here is my worksheet:

A B C D E F
1 1 2 3 4 5
2 D H E N K
3 Peter afs 1 x aft
4 David x fer 1 1
5 Gordon 1 1 fer fer fer

Row 1 shows the date
Row 2 shows a category
The user input area is B3:F5

I want to filter the data and have them listed as shown below
The output should be like this: "name - date - category - user input"
The only cells that should not appear on the list are cells with the values
"x" or "1" or blank cells

After filtering the list should look like this:
Peter 1-D-afs
Peter-4-N-aft
David-2-H-fer
Gordon-3-E-fer
Gordon-4-N-fer
Gordon-5-K-fer

Thank you for any suggestions.

Kaj Pedersen

You need a macro for this.

Set up your workbook with two worksheets -- one for your data, and one for the results.
In the macro, you will see were I assumed they were named Data and Results. You can change that.

The macro assumes there is nothing in column A or row 1 that does not relate to the data
It also puts the results in separate cells; I was not clear if you meant the "-" to represent a different cell, or if you wanted the results all in a single cell per Name.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN.

================================
Option Explicit
Sub FilterSpecial()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim vSrc As Variant
Dim vRes() As Variant
Dim rDest As Range
Dim LastRow As Long, LastCol As Long
Dim I As Long, J As Long, K As Long
Dim S As String

Set WS1 = Worksheets("Data")
Set WS2 = Worksheets("Results")
Set rDest = WS2.Range("a1")
WS2.Cells.Clear

With WS1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
vSrc = .Range("A1", .Cells(LastRow, LastCol))
End With

'Rows in Results
K = 0
For I = 3 To UBound(vSrc)
For J = 2 To UBound(vSrc, 2)
S = vSrc(I, J)
If S < "" And _
S < "x" And _
S < "1" Then _
K = K + 1
Next J
Next I

ReDim vRes(1 To K + 1, 1 To 4)

K = 2
vRes(1, 1) = "Name"
vRes(1, 2) = "Date"
vRes(1, 3) = "Category"
vRes(1, 4) = "User Input"
For I = 3 To UBound(vSrc)
For J = 2 To UBound(vSrc, 2)
S = vSrc(I, J)
If S < "" And S < "x" And S < "1" Then
vRes(K, 1) = vSrc(I, 1)
vRes(K, 2) = vSrc(1, J)
vRes(K, 3) = vSrc(2, J)
vRes(K, 4) = S
K = K + 1
End If
Next J
Next I

Set rDest = rDest.Resize(UBound(vRes), UBound(vRes, 2))
rDest = vRes
rDest.EntireColumn.AutoFit

End Sub
====================================