Hi All

As the subject states, I need to copy cName.Values from one sheet to
another, although, I don't need every instance of the cName.Values, just one
of each.

I then need it to go back again, find the Count of each cName, and repeat it
to find the Sum of each cName.

Dim SS As Sheet 'Source Sheet
Dim DS As Sheet 'Destination Sheet
Dim myRng As Range
Dim cName As String
Dim Sum_myCrng As Range

Set myRng = Range("F2:F200")
Set Sum_myCrng = Range("R2:R200")

eg

cName: MINS:
ABC Co. 50
XYZ Corp 250
ABC Co. 45
ABC Co. 100

So, for each cName in myRng I need to copy the name into
Sheets("Data").Column ("A").

I use the following to find the first empty cell along Column ("A")...

Columns("A").Find("", Cells(Rows.Count, "A"), xlValues, _
xlWhole, , xlNext).Select

Paste the cName from SS and repeat till one instance of all cNames has been
copied across to DS.

Next

Back to SS, count how many instances of each cName there are in myRng, then
go back to DS paste the Count.Value for each cName in Column ("A").Offset(0,
2) 'which is column C.

Next

Back to SS, Sum each cName there are in Sum_myCrng, then go back to DS paste
the Sum.Value for each cName in Column ("A").Offset(0, 1) 'which is column
B.

Hi Mick,

Am Sat, 2 Jul 2011 21:58:08 +1000 schrieb Vacuum Sealed:

So, for each cName in myRng I need to copy the name into
Sheets("Data").Column ("A").

I would use advanced filter to copy unique names to DS:

DS.Select
SS.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Claus

Thanj you for your reply.

I should have mentioned although I am using 2007, this will be a 2003 WB.

I Compiled the code and it shot up an error on SS.Columns..

Error: Method ot Data Member not found

So I tried it this way and Bingo...!!!! Exactly the same outcome..:)

Sub Process_Ingleburn()

Dim SSht As Sheets 'Source Sheet
Dim DSht As Sheets 'Destination Sheet
Dim myRng As Range
Dim cName As Variant

Set SSht = Sheets("Ingleburn Data")
Set DSht = Sheets("Ingleburn")
myRng = Range("F:F")

DSht.Select
Columns("A").Find("", Cells(Rows.Count, "A"), xlValues, _
xlWhole, , xlNext).Select
SSht.Select

For Each cName In myRng

With myRng
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell, Unique:=True
End With

Next cName

End Sub
Thx
Mick

Hi Mick,

Am Sun, 3 Jul 2011 00:55:11 +1000 schrieb Vacuum Sealed:

For Each cName In myRng

With myRng
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell, Unique:=True
End With

Next cName

you don't need the for...next.
Sub Process_Ingleburn()

Dim SSht As Worksheet 'Source Sheet
Dim DSht As Worksheet 'Destination Sheet
Dim myRng As Range

Set SSht = Sheets("Ingleburn Data")
Set DSht = Sheets("Ingleburn")
Set myRng = SSht.Range("F:F")

Application.Goto DSht.[A1]
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell, Unique:=True

End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Thx again Claus

Something interesting.

I got this to work, but it had an unusual twist to the end of the code.

Sub Process_Ingleburn()

Dim SSht As Worksheet 'Source Sheet
Dim DSht As Worksheet 'Destination Sheet
Dim myRng As Range
Dim cName As Variant

Set SSht = Sheets("Ingleburn Data")
Set DSht = Sheets("Ingleburn")
Set myRng = Range("F:F")

SSht.Select

With myRng(cName, myRng)
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell, Unique:=True
End With

For Each cName In myRng

DSht.Select
Columns("A").Find("", Cells(Rows.Count, "A"), xlValues, _
xlWhole, , xlNext).Select

Next cName

End Sub


Instead of copying the variant values to the DSht where the first available
empty cell was in Column A, it copied them to SSht.Range("D37:D52")...LOL...

Any Idea's on how/why it would do that....

BTW:

In your code:

Application.Goto DSht.[A1]
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell, Unique:=True

I need this to search for an empty cell starting from A5, then each time it
loops to the next cName, it will then find the next empty cell along column
again.

Cheers
Mick.

Claus

Worked it out, and your code it working very nicely thanks, onto the next
stage.

Thx again.
Mick.

Vacuum Sealed explained :
Hi All

As the subject states, I need to copy cName.Values from one sheet to another,
although, I don't need every instance of the cName.Values, just one of each.

I then need it to go back again, find the Count of each cName, and repeat it
to find the Sum of each cName.

Dim SS As Sheet 'Source Sheet
Dim DS As Sheet 'Destination Sheet
Dim myRng As Range
Dim cName As String
Dim Sum_myCrng As Range

Set myRng = Range("F2:F200")
Set Sum_myCrng = Range("R2:R200")

eg

cName: MINS:
ABC Co. 50
XYZ Corp 250
ABC Co. 45
ABC Co. 100

So, for each cName in myRng I need to copy the name into
Sheets("Data").Column ("A").

I use the following to find the first empty cell along Column ("A")...

Columns("A").Find("", Cells(Rows.Count, "A"), xlValues, _
xlWhole, , xlNext).Select

Paste the cName from SS and repeat till one instance of all cNames has been
copied across to DS.

Next

Back to SS, count how many instances of each cName there are in myRng, then
go back to DS paste the Count.Value for each cName in Column ("A").Offset(0,
2) 'which is column C.

Next

Back to SS, Sum each cName there are in Sum_myCrng, then go back to DS paste
the Sum.Value for each cName in Column ("A").Offset(0, 1) 'which is column B.

Appreciate the assist
As Always!

TIA
Mick.

One way that doesn't involve formulas... (watch word wraps)

Sub CollectData1()
Dim vData, vaData()
Dim sTemp As String, i As Integer, lRows As Long
Dim rngNames As Range, rngMinutes As Range
Dim wksSource As Worksheet, wksTarget As Worksheet

Set wksTarget = Sheets("Inglebum")
Set rngNames = Sheets("Inglebum Data").Range("$F$1:$F$200")
Set rngMinutes = Sheets("Inglebum Data").Range("$R$1:$R$200")

'Get unique names
vData = rngNames
For i = 1 To UBound(vData)
If Not InStr(1, sTemp, vData(i, 1), vbTextCompare) 0 Then _
sTemp = sTemp & "~" & vData(i, 1)
Next
sTemp = Mid$(sTemp, 2): vData = Split(sTemp, "~")

'Get related data
lRows = UBound(vData) + 1: ReDim vaData(1 To lRows, 1 To 3)
vaData(1, 1) = "Name": vaData(1, 2) = "Minutes": vaData(1, 3) =
"Instances"
For i = 2 To lRows
vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames,
vData(i - 1), rngMinutes)
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames,
vData(i - 1))
Next
wksTarget.Range("$A$1").Resize(UBound(vaData), 3) = vaData
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Garry

This works really well, thank you..

Can this:

vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames, vData(i -
1), rngMinutes)
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))

be expanded to:

vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames, vData(i -
1), rngMinutes) / vaData(i, 3)
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))

I was hoping that if possible it would automagically Average(SumTotal) by
the (No. of Visits)

Cheers
Mick.

Vacuum Sealed explained :
Hi Garry

This works really well, thank you..

Can this:

vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames, vData(i -
1), rngMinutes)
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))

be expanded to:

vaData(i, 1) = vData(i - 1)

vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames,
vaData(i, 1))
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames,
vaData(i, 1), rngMinutes) / vaData(i, 3)


I was hoping that if possible it would automagically Average(SumTotal) by the
(No. of Visits)

Cheers
Mick.

Well, yes if you move the order of the lines as shown because you need
vaData(i, 3) to contain a value to divide by, otherwise an error
occurs.
*Note* I changed the 2nd/3rd ref to vData(i - 1) to vaData(i, 1).

Also, I suggest you change the column heading to...

vaData(1, 2) = "Avg Minutes"

...in line2 of the 'Get related data' section.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thank you Garry

I will change

Cheers
Mick.

Mick,
How about 4 columns...

Option Explicit

Sub CollectData_Into4Cols()
Dim vData, vaData()
Dim sTemp As String, i As Integer, lRows As Long
Dim rngNames As Range, rngMinutes As Range
Dim wksSource As Worksheet, wksTarget As Worksheet

Set wksTarget = Sheets("Inglebum")
Set rngNames = Sheets("Inglebum Data").Range("$F$1:$F$200")
Set rngMinutes = Sheets("Inglebum Data").Range("$R$1:$R$200")

'Get unique names
vData = rngNames
For i = 1 To UBound(vData)
If Not InStr(1, sTemp, vData(i, 1), vbTextCompare) 0 Then _
sTemp = sTemp & "~" & vData(i, 1)
Next
sTemp = Mid$(sTemp, 2): vData = Split(sTemp, "~")

'Get related data
lRows = UBound(vData) + 1: ReDim vaData(1 To lRows, 1 To 4)
vaData(1, 1) = "Name": vaData(1, 2) = "Total Minutes"
vaData(1, 3) = "Total Visits": vaData(1, 4) = "Avg Minutes"
For i = 2 To lRows
vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.SumIf(rngNames,
vaData(i, 1), rngMinutes)
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames,
vaData(i, 1))
vaData(i, 4) = vaData(i, 2) / vaData(i, 3)
Next
wksTarget.Range("$A$1").Resize(UBound(vaData), 4) = vaData
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thx again Garry

I managed to find a way around it by swapping 2 & 3 around as you suggested
in your previous post.

Sub Process_Ingleburn_Dels()

Dim vData, vaData()
Dim sTemp As String, i As Integer, lRows As Long
Dim rngNames As Range, rngMinutes As Range
Dim wksSource As Worksheet, wksTarget As Worksheet

Set wksTarget = Sheets("Ingleburn")
Set rngNames = Sheets("Ingleburn Data").Range("$F$1:$F$200")
Set rngMinutes = Sheets("Ingleburn Data").Range("$P$1:$P$200")

'Get unique names

vData = rngNames

For i = 1 To UBound(vData)
If Not InStr(1, sTemp, vData(i, 1), vbTextCompare) 0 Then _
sTemp = sTemp & "~" & vData(i, 1)

Next

sTemp = Mid$(sTemp, 2): vData = Split(sTemp, "~")

'Get related data
lRows = UBound(vData) + 1: ReDim vaData(1 To lRows, 1 To 3)
vaData(1, 1) = "PICK UP FROM": vaData(1, 2) = "# of VISITS": vaData(1, 3)
= "AVERAGE (MINS)"

For i = 2 To lRows

vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 3) = Application.WorksheetFunction.SumIf(rngNames, vData(i -
1), rngMinutes) / vaData(i, 2)

Next
wksTarget.Range("$A$19").Resize(UBound(vaData), 3) = vaData

Range("A19").Select
Range("A19:C60").Sort Key1:=Range("A20"), Order1:=xlAscending, Header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("A1").Select

End Sub

Cheers
Mick.

I was thinking that for report printing you might want to show:

Name, Total Minutes, Total Visits, Avg Mins Per Visit

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc