Then the code below should pretty much work for you. You'll need to change
the definition of the Const 'mainSheetName' to = the real source sheet's name.
This code goes into the worksheet events code area of the sheet that you
want to have the new short list show up on. I assume that you'll be entering
the name into cell A1 and the month # into B1. Those addresses can also be
changed in the code. And I also assume that row 2 on this sheet has labels
much like the labels on the source data sheet in its row #1.
To put this code into the proper location: Open a copy of your workbook
(best to test with a copy). Go to the sheet that will be having the short
list built in and Right-Click on its name tab. Choose [View Code] from the
list that appears. The VB Editor will open showing an empty code module.
Copy the code below, paste it into that code module, make required edits to
it and close the VB editor.
From that point (if macros are enabled), when you enter a name and month #
into A1 and B1 on the sheet, a new list will be built. There is a kind of
'gotcha' with this because we're looking at possible changes in A1 and B1: if
both cells have entries and then you just change one of them, a new list will
be built, then if you change the other entry, yet another list will be
rebuilt. For best results without building lists needlessly, when you want
to build a particular list, choose one or both of the A1/B1 cells and [Del]
the entry in it/them before changing a value in one. Play with it a little,
and I think you'll get the idea, and also see how you could have one name in
A1 and then simply by changing the month # in B1, get new lists showing that
person's entries for different months.
Here's the code:
Private Sub Worksheet_Change(ByVal Target As Range)
'redefine these Const values to work with the
'layout/content of your workbook
'the 'main...' entries refer to the worksheet
'that has the large list you want to draw from
'
Const mainSheetName = "Sheet1"
Const mainNameCol = "R"
Const mainDateCol = "AO"
Const main1stDataRow = 2 ' assumes labels in row 1
'these deal with this sheet, the one where
'the requested data will be copied to
'address that you'll enter the name into
' the $ symbols are required
Const nameEntry = "$A$1"
Const dateEntry = "$B$1"
Const dest1stDataRow = 3 ' assumes labels in row 2
'variables for use
Dim nameToMatch As String
Dim monthToMatch As Integer
Dim offset2Date As Integer
Dim anyLargeRange As Range
Dim anyCell As Range
Dim lastRow As Long
'did a change take place in either cell
Select Case Target.Address
Case Is = nameEntry, dateEntry
'is there an entry in dateEntry to use?
If IsEmpty(Range(nameEntry)) Or _
IsEmpty(Range(dateEntry)) Then
Exit Sub ' can't run, not enough data
End If
Case Else
'no change to nameEntry or dateEntry, do nothing
Exit Sub
End Select
nameToMatch = Range(nameEntry)
'assumes date/month entries are actually a
'single digit value as 1, 2, ... 11, 12
'NOT a date specially formatted.
monthToMatch = Range(dateEntry)
offset2Date = Range(mainDateCol & 1).Column - _
Range(mainNameCol & 1).Column
'if you get to here, there is something in
'both nameEntry and dateEntry
'clear out any previous results on this sheet
lastRow = Range(mainNameCol & Rows.Count).End(xlUp).Row
If lastRow >= dest1stDataRow Then
Set anyLargeRange = Range(mainNameCol & dest1stDataRow & _
":" & mainNameCol & lastRow)
anyLargeRange.Rows.EntireRow.Delete
End If
'now get range to examine on the main sheet
lastRow = ThisWorkbook.Worksheets(mainSheetName) _
.Range(mainNameCol & Rows.Count).End(xlUp).Row
If lastRow < main1stDataRow Then
Exit Sub ' no list to examine!
End If
Set anyLargeRange = ThisWorkbook.Worksheets(mainSheetName) _
.Range(mainNameCol & main1stDataRow & ":" & _
mainNameCol & lastRow)
'now look for matches
'disable event processing to keep from trying to
're-enter this routine continuously during processing
Application.EnableEvents = False
On Error GoTo ChangeExit
For Each anyCell In anyLargeRange
If anyCell = nameToMatch And _
anyCell.Offset(0, offset2Date) = monthToMatch Then
'have a match, copy the row
anyCell.EntireRow.Copy
Range("A" & Range(mainNameCol & Rows.Count).End(xlUp) _
.Offset(1, 0).Row).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
Next
ChangeExit:
If Err <> 0 Then
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, _
vbOKOnly, "Error Reported"
Err.Clear
End If
On Error GoTo 0
Set anyLargeRange = Nothing ' good housekeeping
Application.EnableEvents = True
MsgBox "Job Completed"
End Sub
Jim said:
It is the month numbers, Jan- 1, Feb-2 etc.
The column that the month number is in is AO
--
Jim
:
On the main list sheet, do you have dates or just month numbers in a column
to compare against the month number you are wanting to find? And what column
is that information in?
:
Hello, In Excel 2007 I am trying to create a new sheet that will list all
rows that have the same entry in it. I can not use the filter option on the
main sheet as each person will only be allowed to see their own data so is
there are function that might assist me?
I.e. If the person type Paul into a cell and the month number in to another
then the list that is created and displayed is all the rows that contain the
name Paul in column R for the given month.
Thanks for any asssitance offered
