Need Help w/ Excel Formula...Mailing List Sort/Filter...Please!!!
I have a catalog business, that sends to schools throughout the US. Larger schools have multiple listings per one location, as they have more teachers. However, I don't want to filter out ALL dupes in the list. I want to setup some sort of "IF more than 3 teachers, send 2 catalogs", and "IF more than 5 teachers, send 3 catalogs"...rule.
I want to keep as GREEN as possible, and not waste these things, let alone be economical in the mailing process, while still being effective in coverage.
Anyone have a solution for me? The list has the school address, as well as professor name. So, basically, same school name/address, will have up to 10 teachers. But, I only want to send to 3 of them... Doesn't matter which, so much as they get something.
Any help is greatly appreciated.. Is this even possible? I know the conditional formatting is most likely the way to go about it.. But, I have 18k listings, and don't have time to look, and hit delete the 3,000 times I'll need to...
Steve, thanks for the quick response... Database App, like what? aasdfasdfasdfasdfasdfasdfasdf
This is just our mailing list, compiled from numerous accounts over the past 2 years. It isn't in any specific order, right now I have it sorted by school name.. so the columns go as follows: School Name, Street, City, State, Zip Code, First/Last, Dept, Origin List
So, each school has at least 1 teacher, but some have as many as 20.. It would be incredibly wasteful to send 20 catalogs, so I only want to send as many as 3-4...
If there was a way to filter down listings based on how many there are... that would be perfect.. For example.. If more than 1, send 2, if more than 5, send 3, if more than 10, send 4... Something like that... See, the problem is the filter will only knock those xxx potential (same address, different teacher name) records right down to 1.. Instead of some compromise in between.
Does this make sense? Thanks again so much for the help!
Basically, I would love for Charlotte Technical to get 4, because they have more than 10 listings. Lee would get 3, because they have more than 4 listings. Lorenzo, Eastern Suffolk, and Southampton would get 1, because they have less than 4 listings. Does this make more sense now?
Thanks a lot man, I appreciate it.. So does mother nature... I have a couple bags of customized M&Ms (our company logo) on them to send... And, anything else I think you might enjoy, that I have around.. Had I paypal, I'd send you $20..
Option Explicit
Sub SelectCatalogRecipients()
Dim lngRow As Long
Dim lngLastRowSheet1 As Long
Dim lngTemp1 As Long, lngTemp2 As Long, lngTemp3 As Long, lngTemp4 As Long
Dim intLevels(10) As Integer
' Set up new column header
Sheet1.Cells(1, 7) = "Catalog"
' Turn off screen updating, which slows down processing
Application.ScreenUpdating = False
' Set up levels
intLevels(0) = 4
intLevels(1) = 1
intLevels(2) = 2
intLevels(3) = 6
intLevels(4) = 11
' Find last row in Column A with content
lngLastRowSheet1 = 0
If IsEmpty(Sheet1.Cells(1, 1)) Then
Exit Sub
Else
lngLastRowSheet1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
End If
' Note: The worksheet must be sorted by School to work properly.
Worksheets(1).Range("A1:G" & CStr(lngLastRowSheet1)).Sort _
Key1:=Worksheets(1).Cells(1, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
lngRow = 2
Do While Sheet1.Cells(lngRow, 1) <> ""
If lngRow + 1 <= lngLastRowSheet1 Then
lngTemp2 = 1
For lngTemp1 = lngRow + 1 To lngLastRowSheet1
If Sheet1.Cells(lngTemp1, 1) = Sheet1.Cells(lngRow, 1) Then lngTemp2 = lngTemp2 + 1
Next lngTemp1
If lngTemp2 = 1 Then
Sheet1.Cells(lngRow, 7) = "Yes"
lngRow = lngRow + 1
Else
' Determine # of catalogs to send
lngTemp4 = 0
For lngTemp3 = intLevels(0) To 1 Step -1
If lngTemp4 = 0 Then
If lngTemp2 >= intLevels(lngTemp3) Then lngTemp4 = lngTemp3
End If
Next lngTemp3
If lngTemp4 = 0 Then lngTemp4 = 1
lngTemp3 = 1
Sheet1.Cells(lngRow, 7) = "Yes"
For lngTemp1 = lngRow + 1 To lngLastRowSheet1
If lngTemp3 < lngTemp4 Then
If Sheet1.Cells(lngTemp1, 1) = Sheet1.Cells(lngRow, 1) Then
Sheet1.Cells(lngTemp1, 7) = "Yes"
lngTemp3 = lngTemp3 + 1
End If
End If
Next lngTemp1
lngRow = lngRow + lngTemp2
End If
Else
Sheet1.Cells(lngRow, 7) = "Yes"
lngRow = lngLastRowSheet1 + 1
End If
' Update status bar message to show progress
Application.StatusBar = CStr(lngRow) & " Rows processed"
DoEvents
Loop
' Turn on screen updating
Application.ScreenUpdating = True
Application.StatusBar = Empty
Sheet1.Activate
End Sub
So, I was thinking of something along these lines would do it... See below:
Let us assume that your first record is in row1. Go to the first
empty column of your first record. I will call this column 'field2'.
In this cell (record1 x field2) type the number 1. Now go to the cell
directly below it (record2 x field2) and type the following formula:
=IF(A2=A1,0,1). The cell references "A1" and "A2" will have to be
modified to fit your spreadsheet but basically you want to compare the
field1 value in row2 to the field1 value in row1. The formula says: if
they are identical return a 0, otherwise return a 1. Once you have
entered this formula copy it down for all records. Since it is a
formula, you only need to type it once and then copy it down (either
by dragging the cell down or by double-clicking the box in the lower
right hand corner of the cell).
Now, after doing that, all duplicates will have a 0 next to them.. But, is there a way, to have the formula calculate some sort of 'points' system, where if the school has 5+ points, then keep 2 records.. ?
You could come up with a formula that counts the number of matches for each school - Excel has a function for this - and you could then use a table elsewhere on the worksheet to determine how many catalogs to send to each school. However, this might be more trouble to set up and maintain than the macro code. It is up to you. The macro does work. If you want to make the table part of the spreadsheet or workbook (Sheet2), that can easily be done.
Sparks - He may have given me the program. But, I DID manipulate it to give me different desired results! So, there was some self-modification involved.
JDC..... In case you might be interested. Well, maybe even someone else someday doing the same thing.......... I added to the levels of distribution (integer levels I think they're called), and also changed the output column.
Option Explicit
Sub SelectCatalogRecipients()
Dim lngRow As Long
Dim lngLastRowSheet1 As Long
Dim lngTemp1 As Long, lngTemp2 As Long, lngTemp3 As Long, lngTemp4 As Long
Dim intLevels(10) As Integer
' Set up new column header
Sheet1.Cells(1, 7) = "Catalog"
' Turn off screen updating, which slows down processing
Application.ScreenUpdating = False
' Find last row in Column A with content
lngLastRowSheet1 = 0
If IsEmpty(Sheet1.Cells(1, 1)) Then
Exit Sub
Else
lngLastRowSheet1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
End If
' Note: The worksheet must be sorted by School to work properly.
Worksheets(1).Range("A1:G" & CStr(lngLastRowSheet1)).Sort _
Key1:=Worksheets(1).Cells(1, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
lngRow = 2
Do While Sheet1.Cells(lngRow, 1) <> ""
If lngRow + 1 <= lngLastRowSheet1 Then
lngTemp2 = 1
For lngTemp1 = lngRow + 1 To lngLastRowSheet1
If Sheet1.Cells(lngTemp1, 1) = Sheet1.Cells(lngRow, 1) Then lngTemp2 = lngTemp2 + 1
Next lngTemp1
If lngTemp2 = 1 Then
Sheet1.Cells(lngRow, 11) = "Yes"
lngRow = lngRow + 1
Else
' Determine # of catalogs to send
lngTemp4 = 0
For lngTemp3 = intLevels(0) To 1 Step -1
If lngTemp4 = 0 Then
If lngTemp2 >= intLevels(lngTemp3) Then lngTemp4 = lngTemp3
End If
Next lngTemp3
If lngTemp4 = 0 Then lngTemp4 = 1
lngTemp3 = 1
Sheet1.Cells(lngRow, 11) = "Yes"
For lngTemp1 = lngRow + 1 To lngLastRowSheet1
If lngTemp3 < lngTemp4 Then
If Sheet1.Cells(lngTemp1, 1) = Sheet1.Cells(lngRow, 1) Then
Sheet1.Cells(lngTemp1, 11) = "Yes"
lngTemp3 = lngTemp3 + 1
End If
End If
Next lngTemp1
lngRow = lngRow + lngTemp2
End If
Else
Sheet1.Cells(lngRow, 11) = "Yes"
lngRow = lngLastRowSheet1 + 1
End If
' Update status bar message to show progress
Application.StatusBar = CStr(lngRow) & " Rows processed"
DoEvents
Loop