![]() |
![]() |
|
|||||||
| Excel Questions All Excel/VBA questions - formulas, macros, pivot tables, general help, etc. Please post to this forum in English only. |
![]() |
|
|
Thread Tools | Display Modes |
|
|
#1 |
|
New Member
Join Date: May 2002
Posts: 4
|
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 |
|
Legend
Join Date: Feb 2002
Location: Minneapolis, Mn, USA
Posts: 9,704
|
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
_________________ Cheers, NateO ![]() [ This Message was edited by: NateO on 2002-05-08 20:00 ] |
|
|
|
![]() |
| Bookmarks |
| Thread Tools | |
| Display Modes | |
|
|