Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: search, if matches then copy

  1. #1
    New Member
    Join Date
    May 2002
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I have a excel file called master name list.xls , it contains 2 fields, UserName and UserGroup.

    Everyday my database program will export its data in to a excel file which is a mix of user names and user groups(some times this database program will put users in the wrong group).

    I want to match the first user name in the data file with the master name list and if found that row should be copied to to the corresponding group sheet(we have 6 user groups and 400 users)

    Any help will be greatly appreciated because Iam doing this manually everyday and its very very time consuming and I dont know any serious coding.

    cheers..
    Arun

  2. #2
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Arun,

    I haven't tested this, but I think it should work, just need to modify the range to check and columns/ranges to search in. Also, this looks for duplicates, not sure if you want that functionality or not. Worth a shot:

    Code:
    Dim Wkbk1 As Workbook, Wkbk2 As Workbook, cell As Range
    Dim origSheet As Worksheet, destSheet As Worksheet, srcSheet As Worksheet
    Dim SourceCell, myrw As Long, myrw2 As Long
    Dim mycl As Range, mycl2 As Range
    
    Set Wkbk1 = Application.Workbooks("A") 'change letter to your workbook
    Set Wkbk2 = Application.Workbooks("B") 'change letter to your workbook
    Set srcSheet = Wkbk1.Sheets(1)
    Set origSheet = Wkbk2.Sheets(1)
    Set destSheet = Wkbk1.Sheets(2)
    
    For Each cell In srcSheet.[a1:b300] 'change this range to your liking
    SourceCell = cell.Value
    Set mycl = origSheet.Columns("a:b").Find(What:=SourceCell)
    If mycl Is Nothing Then GoTo 1:
    myrw = mycl.Row
    myrw2 = destSheet.[a65536].End(xlUp).Offset(1).Row
    origSheet.Range(myrw & ":" & myrw).Copy destSheet.Range("a" & myrw2)
    again:
    Set mycl2 = origSheet.Columns("a:b").Find(What:=SourceCell, After:=mycl)
    If Not mycl2 Is Nothing Then
        If mycl2.Row > mycl.Row Then
            myrw = mycl2.Row
            myrw2 = destSheet.[a65536].End(xlUp).Offset(1).Row
            origSheet.Range(myrw & ":" & myrw).Copy destSheet.Range("a" & myrw2)
            Set mycl = mycl2
            GoTo again
        End If
    End If
    1: Next cell
    MsgBox "Voila!"
    End Sub
    And, change the workbook names, from A & B to the names of your list and data dump.

    _________________
    Cheers, NateO

    [ This Message was edited by: NateO on 2002-05-08 20:00 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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