check value with array, Application.Match

[Przemek]

Hi, I'm trying to copy rows to 2 others sheets, looping through cells
if cell value match with one of array value. But it copies all rows. It
seems, that application.match doesn't work properly.

My code:

Sub makro()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim RngCell As Range
Dim nettingList() As Variant
Dim res As Variant
'Set wks = .Worksheets("wejscia T")
nettingList() = Array("UK", "GE", "FR", "IT", "SP", "HK", _
"US", "INT", "IRL", "CZ", "JP")
With Workbooks(ActiveWorkbook.Name)
Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set wsB = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
wsA.Name = "wejscia T netting"
wsB.Name = "wejscia T outnet"
With .Worksheets("wejscia T Avon 2005")
.Rows(1).Copy Destination:=wsA.Range("A1")
.Rows(1).Copy Destination:=wsB.Range("A1")
For Each RngCell In .Range("C2:C" & .Range("C" &
..Rows.Count).EndxlUp).Row)
res = Application.WorksheetFunction.Match(RngCell.Value, nettingList)
If IsError(res) Then
With wsB
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
Else
With wsA
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
End If
Next RngCell
End With
End With
End Sub

How should I use Application.Match function to correct this?

Przemek

 

[Tom Ogilvy]

Sub makro()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim RngCell As Range
Dim nettingList() As Variant
Dim res As Variant
'Set wks = .Worksheets("wejscia T")
nettingList() = Array("UK", "GE", "FR", "IT", "SP", "HK", _
"US", "INT", "IRL", "CZ", "JP")
With Workbooks(ActiveWorkbook.Name)
Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set wsB = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
wsA.Name = "wejscia T netting"
wsB.Name = "wejscia T outnet"
With .Worksheets("wejscia T Avon 2005")
.Rows(1).Copy Destination:=wsA.Range("A1")
.Rows(1).Copy Destination:=wsB.Range("A1")
For Each RngCell In .Range("C2:C" & .Range("C" &
.Rows.Count).End(xlUp).Row)
res = Application.Match(RngCell.Value, nettingList)
If IsError(res) Then
With wsB
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
Else
With wsA
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
End If
Next RngCell
End With
End With
End Sub

 

[Przemek]

Hi Tom, it's still doesn't work as I want to. E.g. if in rngCell is
value TU, it's still copy that row to wsA sheet. What I want to achieve
is, that all rows with RngCell.Value, which match one of array's member
will be copied to sheet wsA, others rows to sheet wsB.

Przemek

 

[Tom Ogilvy]

The code worked fine for me. The records that matched were copied to
netting and those that didn't were copied to outnet.

Perhaps you have embedded blanks or something in column C.

 

[okaizawa]

Hi,

I didn't test your code. but, if you want an exact match,
try this (the 3rd parameter is 0)

res = Application.Match(RngCell.Value, nettingList, 0)

 

[Przemek]

Tx for help, it works now.

Przemek