Consulting

Results 1 to 6 of 6

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

  1. #1
    VBAX Regular
    Joined
    Apr 2013
    Posts
    30
    Location

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

    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

  2. #2
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,081
    Location
    Maybe this,

    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
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  3. #3
    VBAX Regular
    Joined
    Apr 2013
    Posts
    30
    Location
    Thanks but did not work eather...

  4. #4
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,081
    Location
    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) Then
    Should 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"
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  5. #5
    VBAX Regular
    Joined
    Apr 2013
    Posts
    30
    Location
    thanks alot... it's working perfectly...and with the arrays it saves me a lot of code text...

  6. #6
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,081
    Location
    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..
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •