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

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

--
Regards,
Tom Ogilvy

"Przemek" wrote in message
oups.com...
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

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

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.

--
Regards,
Tom Ogilvy

"Przemek" wrote in message
oups.com...
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

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)

--
HTH,

okaizawa


Przemek wrote:
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

Tx for help, it works now.

Przemek