View Single Post
  #12   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein \(MVP - VB\)[_1575_] Rick Rothstein \(MVP - VB\)[_1575_] is offline
external usenet poster
 
Posts: 1
Default Eliminating repeats from a list

Replace the code I gave you earlier with the code below (note that I added
two more Const statements for the money source and destination columns).

Rick

Sub MoveUniqueNames()
Dim X As Long
Dim Y As Long
Dim Z As Long
Dim LastCell As Long
Dim Total As Double
Dim UniqueNames As String
Const SourceColumn As String = "J"
Const SourceStartRow As Long = 1
Const DestinationColumn As String = "A"
Const DestinationStartRow As Long = 5
Const SourceMoneyColumn As String = "K"
Const DestinationMoneyColumn As String = "B"
Const SourceSheet As String = "NEW"
Const UniqueSheet As String = "Billing"
UniqueNames = "*"
Z = DestinationStartRow
With Worksheets(SourceSheet)
LastCell = .Cells(.Rows.Count, SourceColumn).End(xlUp).Row
For X = SourceStartRow To LastCell
If .Cells(X, SourceColumn) < "" Then
If InStr(UniqueNames, "*" & _
.Cells(X, SourceColumn).Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, SourceColumn).Value & "*"
Worksheets(UniqueSheet).Cells(Z, DestinationColumn).Value = _
.Cells(X, SourceColumn).Value
Z = Z + 1
End If
End If
Next
For X = DestinationStartRow To Z - 1
Total = 0
For Y = SourceStartRow To LastCell
If .Cells(Y, SourceColumn).Value = Worksheets(UniqueSheet). _
Cells(X, DestinationColumn).Value Then
Total = Total + .Cells(Y, SourceMoneyColumn).Value
End If
Next
Worksheets(UniqueSheet).Cells(X, DestinationMoneyColumn).Value = Total
Next
End With
End Sub



"sycsummit" wrote in message
...
Yes! This works great!

BUT- now I have a new problem! from the source sheet ("NEW"), there is a
monetary total next to each name. How would I go about summing up all
totals
for the same name and having this total come up next to the corresponding
name on the destination sheet ("Billing")? Ie, if my NEW sheet looks
like:

mike 7.50
mike 6.00
mike 3.00
lou 2.00
lou 1.50
etc

how would I change the Billing sheet to just output this as:
mike 16.50
lou 3.50
etc

?

This may actually get more complicated as I continue to try to automate my
form, but I'm hoping that if I see enough of these code snippets I'll pick
up
on enough of it to write some myself. In the meantime, Rick, I really
appreciate all of this help and support!

"Rick Rothstein (MVP - VB)" wrote:

I generalized the code so you can modify it easily in the future in that
need should ever arise. There are 6 constant (Const) statements toward
the
top of the code that controls where the names will be read from and where
they will be written to. The Const names should be fairly
self-explanatory,
so you should be able to change the setup at will. One comment on your
"J1
through J25" statement. The code, as written, does not need to know how
many
names there are in the list... it will read down to the last filled-in
cell
in the SourceColumn.

Rick

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
Const SourceColumn As String = "J"
Const SourceStartRow As Long = 1
Const DestinationColumn As String = "A"
Const DestinationStartRow As Long = 5
Const SourceSheet As String = "NEW"
Const UniqueSheet As String = "Billing"
UniqueNames = "*"
Z = DestinationStartRow
With Worksheets(SourceSheet)
For X = SourceStartRow To .Cells(.Rows.Count, _
SourceColumn).End(xlUp).Row
If .Cells(X, SourceColumn) < "" Then
If InStr(UniqueNames, "*" & _
.Cells(X, SourceColumn).Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, SourceColumn).Value & "*"
Worksheets(UniqueSheet).Cells(Z, DestinationColumn).Value = _
.Cells(X, SourceColumn).Value
Z = Z + 1
End If
End If
Next
End With
End Sub