I am using Excel 2003. I am working with a list of names of various people,
in one column. I need to have this list reproduced on a blank worksheet with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

....and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

On Mar 25, 1:34*pm, sycsummit
wrote:
I am using Excel 2003. *I am working with a list of names of various people,
in one column. *I need to have this list reproduced on a blank worksheet with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

Yes, there is a way!

Paste this into a new module and hit F5:


'Code
Option Explicit

Public Sub CountDuplicates()

'Declarations
Dim strCellText() As String
Dim strCellUnique() As String

Dim Cell As Range
Dim iCounter As Integer
Dim jCounter As Integer
Dim iNumCells As Integer
Dim iNumDups As Integer
Dim MSG As String
Dim bnDup As Boolean
Dim strSheetName As String
Dim strNewName As String


'Get array of all unique values
iCounter = 1
For Each Cell In Selection

bnDup = False
ReDim Preserve strCellText(iCounter)
strCellText(iCounter) = Cell

For jCounter = 1 To iNumCells
If strCellText(iCounter) = strCellText(jCounter) Then
bnDup = True
End If
Next jCounter

If bnDup = False Then
iNumCells = iNumCells + 1
ReDim Preserve strCellUnique(iNumCells)
strCellUnique(iNumCells) = Cell
End If

iCounter = iCounter + 1
Next Cell


'Get sheet names
strSheetName = ActiveWorkbook.ActiveSheet.Name
strNewName = "NewSheet" & CStr(ActiveWorkbook.Worksheets.Count)

'See if sheet exists, create if it doesn't
If WorksheetExists(strNewName, ActiveWorkbook) Then
Call MsgBox("Rename sheet " & strNewName & ".", vbOKOnly,
"Error")
Exit Sub
Else

ActiveWorkbook.Worksheets.Add.Name = strNewName
Sheets(strNewName).Move
After:=Sheets(ActiveWorkbook.Worksheets.Count)
End If

'Copy and paste
Sheets(strNewName).Activate

For iCounter = 1 To iNumCells
Cells(iCounter, 1) = strCellUnique(iCounter)
Next iCounter



End Sub
Function WorksheetExists(SheetName As String, Optional WhichBook As
Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function

'End of code


HTH

Chris

Here is some code that I use. It requires a reference to the Microsoft
Scripting Runtime library. In the VBE Tools - References - check Microsoft
Scripting Runtime.

Private Sub GetUniqueItems()
Dim cell As Range 'Current cell in range to check
Dim rngToSearch As Range 'Cells to be searched
Dim dic As Scripting.Dictionary 'Dictionary Object
Dim dicItem As Variant 'Items within dictionary object
Dim wks As Worksheet 'Worksheet to populate with
unique items
Dim rngPaste As Range 'Cells where unique items are
placed

Application.ScreenUpdating = False
'Create range to be searched
Set rngToSearch = Intersect(ActiveSheet.UsedRange, Selection)
If rngToSearch Is Nothing Then Set rngToSearch = ActiveCell

'Confirm there is a relevant range selected
If Not rngToSearch Is Nothing Then
'Create dictionay object
Set dic = New Scripting.Dictionary

'Populate dictionary object with unique items (use key to define
unique)
For Each cell In rngToSearch 'Traverse selected range
If Not dic.Exists(cell.Value) And cell.Value < Empty Then
'Check the key
dic.Add cell.Value, cell.Value 'Add the item if unique
End If
Next

If Not dic Is Nothing Then 'Check for dictionary
Set wks = Worksheets.Add 'Create worksheet to populate
Set rngPaste = wks.Range("A1") 'Create range to populate
For Each dicItem In dic.Items 'Loop through dictionary
rngPaste.NumberFormat = "@" 'Format cell as text
rngPaste.Value = dicItem 'Add items to new sheet
Set rngPaste = rngPaste.Offset(1, 0) 'Increment paste range
Next dicItem
'Clean up objects
Set wks = Nothing
Set rngPaste = Nothing
Set dic = Nothing
End If
End If
Application.ScreenUpdating = True
End Sub
--
HTH...

Jim Thomlinson


"sycsummit" wrote:

I am using Excel 2003. I am working with a list of names of various people,
in one column. I need to have this list reproduced on a blank worksheet with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

Sorry... to use the code I posted just select the column that the names are
in and run the code.
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

Here is some code that I use. It requires a reference to the Microsoft
Scripting Runtime library. In the VBE Tools - References - check Microsoft
Scripting Runtime.

Private Sub GetUniqueItems()
Dim cell As Range 'Current cell in range to check
Dim rngToSearch As Range 'Cells to be searched
Dim dic As Scripting.Dictionary 'Dictionary Object
Dim dicItem As Variant 'Items within dictionary object
Dim wks As Worksheet 'Worksheet to populate with
unique items
Dim rngPaste As Range 'Cells where unique items are
placed

Application.ScreenUpdating = False
'Create range to be searched
Set rngToSearch = Intersect(ActiveSheet.UsedRange, Selection)
If rngToSearch Is Nothing Then Set rngToSearch = ActiveCell

'Confirm there is a relevant range selected
If Not rngToSearch Is Nothing Then
'Create dictionay object
Set dic = New Scripting.Dictionary

'Populate dictionary object with unique items (use key to define
unique)
For Each cell In rngToSearch 'Traverse selected range
If Not dic.Exists(cell.Value) And cell.Value < Empty Then
'Check the key
dic.Add cell.Value, cell.Value 'Add the item if unique
End If
Next

If Not dic Is Nothing Then 'Check for dictionary
Set wks = Worksheets.Add 'Create worksheet to populate
Set rngPaste = wks.Range("A1") 'Create range to populate
For Each dicItem In dic.Items 'Loop through dictionary
rngPaste.NumberFormat = "@" 'Format cell as text
rngPaste.Value = dicItem 'Add items to new sheet
Set rngPaste = rngPaste.Offset(1, 0) 'Increment paste range
Next dicItem
'Clean up objects
Set wks = Nothing
Set rngPaste = Nothing
Set dic = Nothing
End If
End If
Application.ScreenUpdating = True
End Sub
--
HTH...

Jim Thomlinson


"sycsummit" wrote:

I am using Excel 2003. I am working with a list of names of various people,
in one column. I need to have this list reproduced on a blank worksheet with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

I believe this macro will do what you want...

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet2").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

It assumes the worksheet with your original (repeated) name list is Sheet1
(in Column A starting at Row 1) and the worksheet you want to put the unique
name list on is Sheet2 (into Column A starting at Row 1).

Rick


"sycsummit" wrote in message
...
I am using Excel 2003. I am working with a list of names of various
people,
in one column. I need to have this list reproduced on a blank worksheet
with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

All of these responses look impressive, but I was hoping there would be a
more simple solution, such as a function I may have overlooked... anything
that would let me type "=(formula)" in the cell and be done with it.

I can work with this though... but where do you put this? How do I input
this stuff into my spreadsheet?

"sycsummit" wrote:

I am using Excel 2003. I am working with a list of names of various people,
in one column. I need to have this list reproduced on a blank worksheet with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

All of these responses look impressive, but I was hoping there would be a
more simple solution, such as a function I may have overlooked... anything
that would let me type "=(formula)" in the cell and be done with it.

I can work with this though... but where do you put this? How do I input
this stuff into my spreadsheet?


"Rick Rothstein (MVP - VB)" wrote:

I believe this macro will do what you want...

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet2").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

It assumes the worksheet with your original (repeated) name list is Sheet1
(in Column A starting at Row 1) and the worksheet you want to put the unique
name list on is Sheet2 (into Column A starting at Row 1).

Rick


"sycsummit" wrote in message
...
I am using Excel 2003. I am working with a list of names of various
people,
in one column. I need to have this list reproduced on a blank worksheet
with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

This response works with my code... I did not check it against the other
postings. If you are not already in the VB editor, press Alt+F11 from any
worksheet to go there. Once there, click on Insert/Module from the VB editor
menu bar and then Copy/Paste my code (repeated here for your convenience)

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet4").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

into the code window that opened there. You can execute the code from any
worksheet, but my guess is you will want to be in Sheet2 (where my code
places the unique names that are listed in Sheet1 starting at Column A, Row
1) in order to see the list being produced; so, go to Sheet2 and then press
Alt+F8 and select MoveUniqueNames from the list, then click on Run. You
should see the unique names listed on Sheet2 starting at Column A, Row 1.

Rick


"sycsummit" wrote in message
...
All of these responses look impressive, but I was hoping there would be a
more simple solution, such as a function I may have overlooked... anything
that would let me type "=(formula)" in the cell and be done with it.

I can work with this though... but where do you put this? How do I input
this stuff into my spreadsheet?


"Rick Rothstein (MVP - VB)" wrote:

I believe this macro will do what you want...

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet2").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

It assumes the worksheet with your original (repeated) name list is
Sheet1
(in Column A starting at Row 1) and the worksheet you want to put the
unique
name list on is Sheet2 (into Column A starting at Row 1).

Rick


"sycsummit" wrote in message
...
I am using Excel 2003. I am working with a list of names of various
people,
in one column. I need to have this list reproduced on a blank
worksheet
with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

Thanks for the direction... I get the concept. But, I am unfamiliar with
this language and syntax!

How would I have to change your code if I wanted to read the whole list of
names from a worksheet titled "NEW", from cells J1 through J25 -- and paste
them in a worksheet called "Billing", as my list of one of each name,
starting with cell A5?

"Rick Rothstein (MVP - VB)" wrote:

This response works with my code... I did not check it against the other
postings. If you are not already in the VB editor, press Alt+F11 from any
worksheet to go there. Once there, click on Insert/Module from the VB editor
menu bar and then Copy/Paste my code (repeated here for your convenience)

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet4").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

into the code window that opened there. You can execute the code from any
worksheet, but my guess is you will want to be in Sheet2 (where my code
places the unique names that are listed in Sheet1 starting at Column A, Row
1) in order to see the list being produced; so, go to Sheet2 and then press
Alt+F8 and select MoveUniqueNames from the list, then click on Run. You
should see the unique names listed on Sheet2 starting at Column A, Row 1.

Rick


"sycsummit" wrote in message
...
All of these responses look impressive, but I was hoping there would be a
more simple solution, such as a function I may have overlooked... anything
that would let me type "=(formula)" in the cell and be done with it.

I can work with this though... but where do you put this? How do I input
this stuff into my spreadsheet?


"Rick Rothstein (MVP - VB)" wrote:

I believe this macro will do what you want...

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet2").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

It assumes the worksheet with your original (repeated) name list is
Sheet1
(in Column A starting at Row 1) and the worksheet you want to put the
unique
name list on is Sheet2 (into Column A starting at Row 1).

Rick


"sycsummit" wrote in message
...
I am using Excel 2003. I am working with a list of names of various
people,
in one column. I need to have this list reproduced on a blank
worksheet
with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

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



"sycsummit" wrote in message
...
Thanks for the direction... I get the concept. But, I am unfamiliar with
this language and syntax!

How would I have to change your code if I wanted to read the whole list of
names from a worksheet titled "NEW", from cells J1 through J25 -- and
paste
them in a worksheet called "Billing", as my list of one of each name,
starting with cell A5?

"Rick Rothstein (MVP - VB)" wrote:

This response works with my code... I did not check it against the other
postings. If you are not already in the VB editor, press Alt+F11 from any
worksheet to go there. Once there, click on Insert/Module from the VB
editor
menu bar and then Copy/Paste my code (repeated here for your convenience)

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet4").Cells(Z, "A").Value = .Cells(X, "A").Value
Z = Z + 1
End If
Next
End With
End Sub

into the code window that opened there. You can execute the code from any
worksheet, but my guess is you will want to be in Sheet2 (where my code
places the unique names that are listed in Sheet1 starting at Column A,
Row
1) in order to see the list being produced; so, go to Sheet2 and then
press
Alt+F8 and select MoveUniqueNames from the list, then click on Run. You
should see the unique names listed on Sheet2 starting at Column A, Row 1.

Rick


"sycsummit" wrote in message
...
All of these responses look impressive, but I was hoping there would be
a
more simple solution, such as a function I may have overlooked...
anything
that would let me type "=(formula)" in the cell and be done with it.

I can work with this though... but where do you put this? How do I
input
this stuff into my spreadsheet?


"Rick Rothstein (MVP - VB)" wrote:

I believe this macro will do what you want...

Sub MoveUniqueNames()
Dim X As Long
Dim Z As Long
Dim UniqueNames As String
UniqueNames = "*"
Z = 1
With Worksheets("Sheet1")
For X = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If InStr(UniqueNames, "*" & .Cells(X, "A").Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, "A").Value & "*"
Worksheets("Sheet2").Cells(Z, "A").Value = .Cells(X,
"A").Value
Z = Z + 1
End If
Next
End With
End Sub

It assumes the worksheet with your original (repeated) name list is
Sheet1
(in Column A starting at Row 1) and the worksheet you want to put the
unique
name list on is Sheet2 (into Column A starting at Row 1).

Rick


"sycsummit" wrote in message
...
I am using Excel 2003. I am working with a list of names of various
people,
in one column. I need to have this list reproduced on a blank
worksheet
with
the repeated names removed.

for instance, the list I'm working with would be something like:
Pat
Pat
Dan
Marie
Marie
Sharron
Sharron
Sharron
Sharron
Daniel
Mark
Mark
Mark
Mark

...and I would need this list to be reproduced on another tab as:
Pat
Dan
Marie
Sharron
Daniel
Mark

Is there a way I can do this?

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

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

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

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

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

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

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.

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

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.

I personally do not use merged cells (they always seem to cause problems),
so I'm not sure if I'll be able to work around the problem for you or not
(depending on if the merged cells are behind it or not); however, I'm
willing to look. If you want to post the file somewhere so we can all see
it, that would be fine. You can also just send it to me directly if you want
(just remove the NO.SPAM stuff from my posted email address).

Rick


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