View Single Post
  #16   Report Post  
Posted to microsoft.public.excel.programming
cht13er cht13er is offline
external usenet poster
 
Posts: 141
Default Eliminating repeats from a list

On Apr 9, 9:08*am, sycsummit
wrote:
Okay... I copied the code there and changed the constants to match with what
I've got as the starting cells for this data.

It's returning an error with the line:

Worksheets(UniqueSheet).Range(DestinationColumn & ":" & _
* * * * * * * * * * * * * * * *DestinationColumn).Clear

Not sure how to correct the problem, but the entire code as it is right now
reads as follows:

Private Sub Worksheet_Activate()
* 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 = 4
* Const DestinationColumn As String = "A"
* Const DestinationStartRow As Long = 5
* Const SourceMoneyColumn As String = "I"
* Const DestinationMoneyColumn As String = "B"
* Const SourceSheet As String = "NEW"
* Const UniqueSheet As String = "Billing"
* UniqueNames = "*"
* Z = DestinationStartRow
* Worksheets(UniqueSheet).Range(DestinationColumn & ":" & _
* * * * * * * * * * * * * * * *DestinationColumn).Clear
* Worksheets(UniqueSheet).Range(DestinationMoneyColu mn & ":" & _
* * * * * * * * * * * * * * * DestinationMoneyColumn).Clear
* 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

If you have an easy fix let me know, otherwise I'll just live with setting
up the macros manually; its not hard and WAY more convenient to the old way
of doing things. *Thanks again,
Matt

"Rick Rothstein (MVP - VB)" wrote:



Delete the MoveUniqueNames subroutine (unless you think you will ever want
to run the code independently; that is, without going to the Billing sheet
in order to make it run) and go to the code window for the Billing sheet
(the easiest way to do that is right-click the tab for the Billing sheet and
select View Code from the popup menu) and Copy/Paste the event procedure
after my signature into that code window. After you have done that, the code
will run whenever you click on the Billing tab when a different sheet is
active. That means, you can make changes to the NEW sheet and by clicking on
the Billing sheet's tab, you will activate the code and go to the Billing
sheet at the same time.


Rick


Private Sub Worksheet_Activate()
* 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
* Worksheets(UniqueSheet).Range(DestinationColumn & ":" & _
* * * * * * * * * * * * * * * *DestinationColumn).Clear
* Worksheets(UniqueSheet).Range(DestinationMoneyColu mn & ":" & _
* * * * * * * * * * * * * * * DestinationMoneyColumn).Clear
* 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
...
Rick-


Thanks again for your help! *This is going to save me soooo much time at
work!


One other question, is it possible to get the script to run all the time?
Ie, so i don't have to hit alt-f8 and run it when I want to print out a
billing report? *If it would, say, access this information every time I
clicked on the "billing" tab, that'd be sweet. *Let me know... *Thanks
again
for everything!


"Rick Rothstein (MVP - VB)" wrote:


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, _


...

read more »- Hide quoted text -

- Show quoted text -


Worksheets(UniqueSheet).Range(DestinationColumn & ":" &
DestinationColumn).Clear

Do you need quotes around the range? e.g. Range("A:V").Clear ?

Chris