Hi Guys,
I have a Workbook that details Customers and the Newspapers they receive for each day of the week. The Customers Sheet has a Matrix of Name, Address, Monday, Tuesday etc across the columns, and for each Row The Name, and a paper code for each day of the week ie. Tel for Telegraph etc.
On the Data Sheet I have a lookup Table detailing paper code against paper.
What I am trying to do is this:-
For each Day say Monday, create a list of Names and the Papers that they receive and paste this onto a Sheet called Monday.
I have managed to crib together the following code, and have suceeded in finding what papers are required, but can only paste the codes I find onto the Monday Sheet, not the corresponding names.
I would appreciate any help.
SD
[VBA]
Option Explicit
Private Sub cmdMonday_Click()
Dim ws1 As Worksheet
Set ws1 = Sheets("Customers")
ws1.Activate
'Call the macro with Monday range.
'This will change for each Day
With ws1
Call SelectPaper(.Range(.Cells(5, 5), .Cells(.Rows.Count, 5).End(xlUp)))
End With
End Sub
'Called from the cmdMonday_Click() Routine on the 'Orders' Sheet
Sub SelectPaper(rngSearch As Range)
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rngMonday As Range, Cell As Object
Application.EnableEvents = False
On Error GoTo ErrUm
Set wb = ActiveWorkbook
Set ws1 = Sheets("Customers")
Set ws2 = Sheets("Monday")
Set ws3 = Sheets("Data")
'Check every cell in the range to see who gets a paper.
For Each Cell In rngSearch
If Cell.Value <> "\" Then
If rngMonday Is Nothing Then
Set rngMonday = Range(Cell.Address)
Else
Set rngMonday = Union(rngMonday, Range(Cell.Address))
End If
End If
Next
'Select the new range of only those who get a paper
rngMonday.Select
'Copy Selection to Monday Sheet
Selection.Copy ws2.Range("B1")
ws2.Activate
Application.EnableEvents = True
Exit Sub
ErrUm:
MsgBox "Doh! Another Error!" & vbNewLine & Err.Description
Err.Clear
Application.EnableEvents = True
End Sub
[/VBA]
Reply With Quote
58,2,FALSE))
Originally Posted by smugdruggler
