I import data into excel sheet1 from an outside source. The data is a list
of names with corosponding events, dates, and instructors. Currently, I sort
through the list manually to organize the information into a calendar type
tracking sheet in sheet2. Column A is a list of 18 different names that
repeat depending on the number of events completed. Columns C,D, and G are
the event, date and instructor respectively. The number of rows in sheet1
increase daily due to each of the 18 people completing more events. In
sheet2, I have the list of 18 names in column B every other row starting at
row 3(3,5,7...37). D1 to EV1 are calendar days (ie. 1 jul to 26 nov).
Right now, I look at the name, event, instructor, and date in sheet1 and
place the event and instructor under the date in the two rows corrosponding
to the appropriate name in column B. For example: Sheet1 Row 1 has frank
completed event1 with mark on 1 jul. In sheet2, lets say frank is in B3.
Therefore, event1 would go under 1jul in row3 and mark would go under 1 jul
in row4.
I have been digging through vba books for a couple of weeks trying to figure
out how to do this with no success. If anyone has any suggestions I would
greatly appreciate them so that I can stop beating my head against the
screen. Thanks.
Erik

Erik
Try this. You should tweak it to match your set up, if necessary, and test
it thoroughly. The most mysterious of problems might arise from not finding
matching ranges in the Finds. If date formats do not match, for instance,
the date range sought may not be found. I test each range and don't continue
if not found, so if data fails to get filled in when you think it should,
step thru the code and see if a range fails to be found. If the wrong data
gets put in the wrong place, see if the wrong range is found, and see that
the initial range set ups are right.

Option Explicit

Sub Main()
Dim colSrcNames As Range 'column of names
Dim colSrcEvent As Range 'column of events
Dim colSrcDate As Range 'column of dates
Dim colSrcInstructor As Range 'column of instructors
Dim strDate As String 'current date variable
Dim strEvent As String 'current event variable
Dim strInstructor As String 'current instructor variable
Dim rngSrcName As Range 'current source name cell

Dim rowTrgName As Range 'current target row
Dim rowTrgDates As Range 'calendar dates
Dim rngTrg As Range 'where current event will be written

'Set a variable to identify the workbook
'(instead of explicit reference in code, for
'brevity & flexibility).
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set wks2 = Workbooks("Book1.xls").Worksheets("Sheet2")
'could be:
'Set wks1 = ThisWorkbook.Worksheets("Sheet1")
'Set wks2 = ThisWorkbook.Worksheets("Sheet2")
'if applicable. Change sheet name to suit.

Set colSrcNames = Intersect(wks1.Columns("A"), wks1.UsedRange)
Set colSrcEvent = wks1.Columns("C")
Set colSrcDate = wks1.Columns("D")
Set colSrcInstructor = wks1.Columns("G")
Set rowTrgDates = wks2.Range("D1:EV1")

If Not colSrcNames Is Nothing Then
'Go thru each name in sheet 1
For Each rngSrcName In colSrcNames
If Len(rngSrcName.Text) 0 Then
On Error Resume Next
'Find this person's row in sheet2
Set rowTrgName =
wks2.Columns("A").Find(rngSrcName.Text).EntireRow
On Error GoTo 0
If Not rowTrgName Is Nothing Then
On Error Resume Next
strDate = Intersect(rngSrcName.EntireRow, colSrcDate).Text
'Find the calendar cell for this person's event data
Set rngTrg = Intersect( _
rowTrgName, rowTrgDates.Find( _
strDate, rowTrgDates.Cells(1), _
xlValues).EntireColumn)
On Error GoTo 0
If Not rngTrg Is Nothing Then
strEvent = Intersect(rngSrcName.EntireRow,
colSrcEvent).Text
strInstructor = Intersect( _
rngSrcName.EntireRow, colSrcInstructor).Text
'Insert the event and the instructor
rngTrg = strEvent
rngTrg.Offset(1, 0) = strInstructor
End If
End If
End If
Next rngSrcName
End If
End Sub

Bob

"Erik" wrote in message
...
I import data into excel sheet1 from an outside source. The data is a
list
of names with corosponding events, dates, and instructors. Currently, I
sort
through the list manually to organize the information into a calendar type
tracking sheet in sheet2. Column A is a list of 18 different names that
repeat depending on the number of events completed. Columns C,D, and G
are
the event, date and instructor respectively. The number of rows in sheet1
increase daily due to each of the 18 people completing more events. In
sheet2, I have the list of 18 names in column B every other row starting
at
row 3(3,5,7...37). D1 to EV1 are calendar days (ie. 1 jul to 26 nov).
Right now, I look at the name, event, instructor, and date in sheet1 and
place the event and instructor under the date in the two rows
corrosponding
to the appropriate name in column B. For example: Sheet1 Row 1 has frank
completed event1 with mark on 1 jul. In sheet2, lets say frank is in B3.
Therefore, event1 would go under 1jul in row3 and mark would go under 1
jul
in row4.
I have been digging through vba books for a couple of weeks trying to
figure
out how to do this with no success. If anyone has any suggestions I would
greatly appreciate them so that I can stop beating my head against the
screen. Thanks.
Erik

Bob,
I tweaked your code slightly and it works great. You just solved about
two and half weeks of frustration for me. I have one more question that I
was hoping to ask you since you already have the basic idea of my spreadsheet.

When I first open the workbook, I have to put all 18 names in manually. How
can I do this with a module? The raw list is roughly 700 lines comprised of
only the 18 names I am interested in and it is alread in alphabetical order.
The names need to go in the odd numbered rows from 3 to 37 in column B of
sheet2 and the even numberd rows from 2 to 36 in column B of sheet3.

Thanks in advance.
Erik

"Erik" wrote in message
...
Bob,
I tweaked your code slightly and it works great. You just solved about
two and half weeks of frustration for me. I have one more question that I
was hoping to ask you since you already have the basic idea of my
spreadsheet.

When I first open the workbook, I have to put all 18 names in manually.
How
can I do this with a module? The raw list is roughly 700 lines comprised
of
only the 18 names I am interested in and it is alread in alphabetical
order.
The names need to go in the odd numbered rows from 3 to 37 in column B of
sheet2 and the even numberd rows from 2 to 36 in column B of sheet3.

Thanks in advance.
Erik

Erik - Try this:

Option Explicit

Sub InsertNames()
'into two worksheets
Dim vName As Variant, colNames As Collection
Dim wks2 As Worksheet, wks3 As Worksheet
Dim lngRow As Long

'freeze GUI while processing
Application.ScreenUpdating = False
lngRow = 0

'get the names, if any
Set colNames = UniqueNames
If colNames Is Nothing Then
Application.ScreenUpdating = True
MsgBox "Error occurred: " & _
"Names collection not properly initialized!"
Else
If colNames.Count < 1 Then
Application.ScreenUpdating = True
MsgBox "Sorry. No names found"
Else
Set wks2 = _
Workbooks("Book1.xls").Worksheets("Sheet2")
Set wks3 = _
Workbooks("Book1.xls").Worksheets("Sheet3")
'insert names into wks3
For Each vName In colNames
lngRow = lngRow + 2
wks3.Columns("B").Rows(lngRow).Value = vName
Next vName

'copy names from wks3 to wks2.
'[assumes UsedRange is appropriate; it has the advantage that
'it allows for more or fewer names, but it may be larger than
'necessary; a problem if additional, unwanted data is copied.
'If so, find another way to identify range to copy.]
Intersect(wks3.Columns("B"), wks3.UsedRange).Copy _
wks2.Range("B3")
End If
End If

'release resources
Set wks2 = Nothing
Set wks3 = Nothing
Set colNames = Nothing

'update GUI
Application.ScreenUpdating = True

End Sub

Function UniqueNames() As Collection
'Returns a unique set of text values from rngNames.
'It depends on the property of the Collection
'object to require unique keys (the second arg to
'col.Add). Trying to add a duplicate throws an
'error which we conveniently ignore. This is a
'common technique.
Dim col As Collection 'we'll return this
Dim wks As Worksheet 'the raw data sheet
Dim rngNames As Range 'the names
Dim cell As Range

Set wks = Workbooks("Book1.xls").Worksheets("Sheet0")
Set rngNames = Intersect(wks.Columns("A"), wks.UsedRange)
Set col = New Collection

On Error Resume Next ' ignore errors
For Each cell In rngNames
col.Add cell.Text, cell.Text
Next cell
On Error GoTo 0 'un-ignore errors

Set UniqueNames = col
Set col = Nothing

End Function


Cheers,
Bob

P.S. Fortunately, I still have power in the midst of hurricane Francis!

Bob,
Thank you again. With slight tweaking works great. I can't begin to
express my gratitude. BTW, didn't know you're in FL. We've been watching on
the news. Hope all is well.
Erik