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

It's saying "error: cannot change part of a merged cell"; then clicking
debug, it highlights the line I mentioned in my last post. Don't know if
it's somehow picking up the merged cells surrounding the source data, if one
of my constants is off by one (though I checked this...) or it's trying to
use the merged cells at the end of the data range as destination values, or
what... again, really not a big deal, but short of posting the file somewhere
I'm not sure how else to ask about this issue- which I can't really do
because of confidentiality policies where I work. If it ends here, I'm happy
to have gotten so much advice and input!

Thanks to all.

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure what to tell you. I just set up a test worksheet naming two
sheets NEW and Billing and copied the code you said you are using into the
code window for the Billing worksheet. I then put a list of names in Column
J starting at Row 4 and a list of numbers in Column I also starting in Row 4
(both of these in the NEW worksheet). When I click on the tab for the
Billing worksheet, the previous unique listing of names and total monies on
the Billing worksheet is cleared and the new information is populated in
their places... no errors are generated.

You say you are getting an error with this line....

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


What is the exact error message you are getting. And what version of Excel
are you using?

Rick



"sycsummit" wrote in message
...
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.