need help to copy rows to a new sheet depend on a cell value

[Aranell]

Hi all,
I need to copy some rows with a specific Value in a Column from sheet1 called "Germany" to Sheet2 called "GIZ".
Example:
Sheet1 "Germany"
Iteam Reference Location
A 1 Germany
B 1 France
C 1 UK
D 2 Italy
E 3 USA
F 3 China

The thing is I don't know the order in Column "Reference" all I know is that they are grouped, but maybe 3 come before 1 or 2 etc..
And I need to keep that order too.

Now I want to copy all Rows with the Reference Nbr 1 and 3 to Sheet2 "GIZ" if possible sorted and grouped like in sheet1

I did a small macro, but i discovered that he missed some rows, and as Sheet1 has more than 3000 rows is difficult to check if he did everything or not.

OH before i forgot I want that he skip the reference and continue with the next one if the reference value is not there in sheet1


Here is my Macro as you see I have here 7 Value as reference.


Sub MyMacro()
Dim i As Long, iMatches As Long
'GIZ
Dim aBerlin() As String: aBerlin = Split("2323209", ",")
Dim aFrankfurt() As String: aFrankfurt = Split("2320979", ",")
Dim aMunich() As String: aMunich = Split("2321657", ",")
Dim aMARS() As String: aMARS = Split("2322974", ",")
Dim aEschborn() As String: aEschborn = Split("2326361", ",")
Dim aCologne() As String: aCologne = Split("2327129", ",")
Dim aCologne2() As String: aCologne2 = Split("2327129", ",")

' Want that the macro copy in Sheet "GIZ" begining from Row 16
iMatches = 15
For Each cell In Sheets("Germany").Range("M:M")
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aBerlin)
If InStr(1, cell.Value, aBerlin(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aFrankfurt)
If InStr(1, cell.Value, aFrankfurt(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aMunich)
If InStr(1, cell.Value, aMunich(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aMARS)
If InStr(1, cell.Value, aMARS(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aEschborn)
If InStr(1, cell.Value, aEschborn(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aCologne)
If InStr(1, cell.Value, aCologne(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
If Len(cell.Value) <> 0 Then
For i = 0 To UBound(aCologne2)
If InStr(1, cell.Value, aCologne2(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
Next
End Sub

[SamT]

Maybe this, :dunno


Sub MyMacro()
Dim i As Long, iMatches As Long
'GIZ
Dim References As Variant
References = Array("2323209", "2320979", "2321657", "2322974", _
"2326361", "2327129", "2327129")

' Want that the macro copy in Sheet "GIZ" begining from Row 16
iMatches = 15
For Each cell In Sheets("Germany").Range("M:M")
If Trim(cell.Value) <> "" Then
For i = 0 To UBound(References)
If InStr(1, cell.Value, aBerlin(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
End If
Next
End If
Next
End Sub

[Aranell]

Thanks but did not work eather...

[SamT]

REfering to the code you posted.

I can't tell what you're trying to do.

What you are doing is setting each of the named arrays to a single 7 character number string. The sames number strings I put in the (single) array in my sub.

Then you are checking each Cell in the range against each of the named Arrays (that only have one value in each of them) to see if the entire string(s) is contained in the cell.

I just noticedthat my code has an error: This bit
If InStr(1, cell.Value, aBerlin(i), vbTextCompare) ThenShould readt
If InStr(1, cell.Value, References(i), vbTextCompare) Then

With that change my code is duplicating the work of your code. If you see what my code is doing, you will see what your code is doing.

From your code:
Split("2323209", ",") = "2323209"

[Aranell]

thanks alot... it's working perfectly...and with the arrays it saves me a lot of code text...

[SamT]

Also, if the References in the Worksheet are formatted as numbers, then you should remove all the quote marks around the numbers in the Reference Array and the vbTextCompare parameter in the Mid Function..