Filtering and Separating Data

[grin2000]

I have the following table:

A B
1 Adam -50
2 James MET
3 Hank -800
4 Will -300
5 Bill MET
6 Ken -98
7 Frank -80
8 Kerry -220
9 Ken -400
10 Bond MET


There are these 10 guys which either met their payments or still owe
certain amount. The status column B can either have a negative numbe
in it or the word MET. So all guys could either have met the deadlin
to pay or still owe. I wanted to have shown on another page in 2 colum
shown like this:

A B
1 GOOD BAD
2 James Adam
3 Bill Hank
4 Bond WIll
5 Ken
6 Frank
7 Kerry
8 Ken
9
10


I just don't know what macro or something else would work that can loo
at the first table and then list the people in the right columns, Goo
and Bad on the first page.

Thanks, I appreciate the help

 

[Tom Ogilvy]

assume your data as shown is on a sheet named DATA and you want your new
table on Sheet2.

Sub AAAA()
With Sheets("Data")
.Rows(1).Insert
.Range("A1").Value = "Name"
.Range("B1").Value = "Status"
.Range("D1").Value = "Status"
.Range("D2").Value = "MET"
End With
With Sheets("Sheet2")
.Range("A1").Value = "Name"
.Range("B1").Value = "Name"
End With

Sheets("Data").Range("A1").CurrentRegion.Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Data").Range("D12"), _
CopyToRange:=Sheets("Sheet2").Range("A1"), _
Unique:=False

Sheets("Data").Range("D2").Value = "<>MET"
Sheets("Data").Range("A1").CurrentRegion.Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Data").Range("D12"), _
CopyToRange:=Sheets("Sheet2").Range("B1"), _
Unique:=False
With Sheets("Sheet2")
.Range("A1").Value = "GOOD"
.Range("B1").Value = "BAD"
End With
Worksheets("Data").Rows(1).Delete
End Sub

 

[Soo Cheon Jheong]

Hi,

Option Explicit
Option Base 1
Sub TEST()

Dim S_1 As Worksheet
Dim S_2 As Worksheet
Dim CL As Range
Dim str_A As String
Dim str_B As String
Dim Lon_A As Long
Dim Lon_B As Long
Dim Lon_R As Long
Dim i As Long
Dim j As Long

Set S_1 = Worksheets("Data")
Set S_2 = Worksheets("List")

Lon_R = S_1.Cells(Rows.Count, 1).End(xlUp).Row
Lon_A = Application.CountIf(S_1.Columns(2), "MET")
Lon_B = Application.CountIf(S_1.Columns(2), "<0")

ReDim AAA(1 To Lon_A, 1) As String
ReDim BBB(1 To Lon_B, 1) As String

For Each CL In S_1.Range("B1:B" & Lon_R)
If UCase(CL.Value) = "MET" Then
i = i + 1
AAA(i, 1) = CL(1, 0).Value
End If
If CL.Value < 0 Then
j = j + 1
BBB(j, 1) = CL(1, 0).Value
End If
Next

S_2.Range("A:B").ClearContents
S_2.Range("A1:B1").Value = Array("GOOD", "BAD")

If Lon_A > 0 Then S_2.Range("A2").Resize(Lon_A, 1).Value = AAA
If Lon_B > 0 Then S_2.Range("B2").Resize(Lon_B, 1).Value = BBB

End Sub


--
Regards,
Soo Cheon Jheong
Seoul, Korea
_ _
^¢¯^
--

 

[grin2000]

Thanks guys. Both of your methods worked perfectly. I really appreciat
your help