Average Value

  • Thread starter Thread starter Saxman
  • Start date Start date
Hi John,

Am Sat, 30 Aug 2014 08:42:19 +0100 schrieb Saxman:


try:

Sub myAvg()
Dim LRow As Long, i As Long, n As Long
Dim Start As Long
Dim rngC As Range
Dim dblAvg As Double
Dim strCol As String, arrCol As Variant

strCol = "X,Z,AA,AB,AC,AD,AE,AK,AL,AM,AN,AO,AP,AQ,AX"
arrCol = Split(strCol, ",")

With ActiveSheet
For n = LBound(arrCol) To UBound(arrCol)
LRow = .Cells(Rows.Count, arrCol(n)).End(xlUp).Row
.Range(.Cells(2, arrCol(n)), .Cells(LRow, arrCol(n))) _
.Replace what:="-", replacement:=""
.Cells(LRow + 1, arrCol(n)) = "End"
Start = 2
For i = Start To LRow
If .Cells(i + 1, arrCol(n)) > .Cells(i, arrCol(n)) Then
dblAvg = WorksheetFunction.AverageIf(.Range(.Cells(Start,
arrCol(n)), _
.Cells(i, arrCol(n))), ">0", .Range(.Cells(Start,
arrCol(n)), _
.Cells(i, arrCol(n))))
.Range(.Cells(Start, arrCol(n)), .Cells(i,
arrCol(n))).Replace _
what:=0, replacement:=dblAvg, lookat:=xlWhole
.Range(.Cells(Start, arrCol(n)), .Cells(i,
arrCol(n))).Replace _
what:="", replacement:=dblAvg, lookat:=xlWhole
Start = i + 1
End If
Next
.Range(.Cells(2, arrCol(n)), .Cells(LRow, arrCol(n))).NumberFormat
= "0"
Next
End With

End Sub
Click to expand...

I ran the above and got a syntax error. On second thoughts it would not
be possible to do multiple columns, as the data needs to be sorted
beforehand. This is so the next sequence can be identified. As you can
see from a sample below, all the columns are random. 'Time' is the
identifier.

Time TS TS1 TS2 TS3 TS4 TS5 TS6
4.45 79 21 41 55 56 79 30
4.45 57 69 69 41 21 45 57
4.45 64 43 68 64 64 32 43
4.45 68 67 49 59 58 - 68
4.45 72 70 57 71 51 9 31
4.45 75 66 57 23 74 63 54
4.45 68 - 51 56 55 67 37
4.45 62 - 22 28 61 55 12
5.15 47 - 35 - 47 31 51
5.15 46 44 51 30 29 46 -
5.15 47 - 19 31 47 21 19
5.15 47 37 46 - 36 28 47
5.15 59 - 23 23 - 32 59
5.15 46 - 34 46 27 38 -
5.15 49 20 49 34 - 18 38
5.15 53 57 44 53 21 45 27
5.15 34 - - - 34 - -
5.45 21 - - 12 21 6 63
5.45 60 54 - - 60 52 54
5.45 39 - - - 25 39 23
5.45 63 17 23 59 53 47 63
5.45 53 41 53 16 28 45 35
5.45 62 27 48 53 28 - 62
5.45 52 30 - - 25 -
5.45 60 27 60 - 45 - -
5.45 56 - 25 25 - 56 -
6.15 86 10 37 58 74 74 86
6.15 25 - - - - - 25
6.15 78 - 78 50 - 58 63
6.15 65 - - - - - 65
6.15 70 - - - 59 56 70
6.15 - - - - - -
6.45 60 39 48 60 32 - 46
6.45 62 57 50 62 39 66 50
6.45 50 52 45 50 27 28 37
6.45 56 36 56 27 30 36 37
6.45 - - 18 24 28 -
6.45 42 22 46 42 - 18 29
6.45 - - - - - 25
6.45 56 27 38 56 31 43 47
6.45 47 - 31 47 42 - -
6.45 62 24 62 21 29 - 29
6.45 52 41 58 47 35 47 23
6.45 - - - 41 - -
7.15 48 20 39 61 48 61 48
7.15 63 54 55 55 56 63 52
7.15 53 35 - 58 53 51 28
7.15 31 - - 31 11 12 -
7.15 46 21 22 12 30 46 34
7.15 30 - - 23 30 10 29
7.15 11 - - 11 11 38 21
7.15 - - - - - -
7.45 81 55 - - - 22 21
7.45 44 12 - 42 - 44 14
7.45 20 33 - 53 10 - 20
7.45 51 60 62 47 37 51 -
7.45 44 57 40 - 19 23 44
7.45 46 50 20 27 39 - 46
7.45 23 38 - - - - 23
7.45 51 70 55 - 47 50 51
 
Hi John,

Am Sat, 30 Aug 2014 10:59:26 +0100 schrieb Saxman:
I ran the above and got a syntax error. On second thoughts it would not
be possible to do multiple columns, as the data needs to be sorted
beforehand. This is so the next sequence can be identified. As you can
see from a sample below, all the columns are random. 'Time' is the
identifier.
Click to expand...

you do not have to sort. That can be solved with AverageIf of
AverageIfs.
Please tell me in which column the time is placed.


Regards
Claus B.
 
Hi John,

Am Sat, 30 Aug 2014 10:59:26 +0100 schrieb Saxman:


you do not have to sort. That can be solved with AverageIf of
AverageIfs.
Please tell me in which column the time is placed.
Click to expand...

There are three identifiers (see below). Columns A, B, C (Date, Time
Course).

The Date would be useful to convert a large database with several days
data, followed by Time.

However, on a daily basis, Time would be sufficient, as it is almost
unique to that day. (On very busy days, like Easter, times can clash).

One could do a sort by Date, Course and Time for complete separation.



Date Time Course
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 4.45 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
30/08/2014 5.15 BATH
 
Hi John,

Am Sat, 30 Aug 2014 11:45:59 +0100 schrieb Saxman:
There are three identifiers (see below). Columns A, B, C (Date, Time
Course).

The Date would be useful to convert a large database with several days
data, followed by Time.

However, on a daily basis, Time would be sufficient, as it is almost
unique to that day. (On very busy days, like Easter, times can clash).
Click to expand...

try:

Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range
Dim FirstAddress As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Union(.Range("X1:X" & LRow), .Range("Z1:AE" & LRow), _
.Range("AK1:AQ" & LRow), .Range("AX1:AX" & LRow))
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
c = WorksheetFunction.AverageIfs(.Range(.Cells(1, c.Column), _
.Cells(LRow, c.Column)), .Range("A1:A" & LRow),
..Cells(c.Row, 1), _
.Range("B1:B" & LRow), .Cells(c.Row, 2), .Range("C1:C" &
LRow), _
.Cells(c.Row, 3))
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub


Regards
Claus B.
 
Hi John,

Am Sat, 30 Aug 2014 11:45:59 +0100 schrieb Saxman:


try:
Click to expand...

I have amended the code to the following

Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range
Dim FirstAddress As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Union(.Range("X2:X" & LRow), .Range("Z2:AE" & LRow), _
.Range("AK2:AQ" & LRow), .Range("AX2:AX" & LRow))
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
c = WorksheetFunction.AverageIfs(.Range(.Cells(1, c.Column), _
.Cells(LRow, c.Column)), .Range("A2:A" & LRow),
..Cells(c.Row, 1), _
.Range("B2:B" & LRow), .Cells(c.Row, 2), .Range("C2:C" &
LRow), _
.Cells(c.Row, 3))
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub

However, I get a syntax error in the following row.

..Cells(c.Row, 1),

If you need to look at the data I have stored an Excel spreadsheet
temporarily here.

https://www.sendspace.com/file/m2atiy
 
Hi John,

Am Sat, 30 Aug 2014 20:05:46 +0100 schrieb Saxman:


the error was because the word wrap

try:
Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range, rngAvg As Range
Dim dblAvg As Double
Dim FirstAddress As String, strCol As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
rngBig.Replace what:="", replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
strCol = Left(c.Address(1, 0), InStr(c.Address(1, 0), "$") - 1)
Set rngAvg = .Range(strCol & "2:" & strCol & LRow)
dblAvg = WorksheetFunction.AverageIfs(rngAvg, _
.Range("A2:A" & LRow), .Range("A" & c.Row), _
.Range("B2:B" & LRow), .Range("B" & c.Row), _
.Range("C2:C" & LRow), .Range("C" & c.Row))
c.Value = dblAvg
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub
Click to expand...

Thank you again. I will test it thoroughly in the morning (UK except
Scotland:-))).
 
Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range, rngAvg As Range
Dim dblAvg As Double
Dim FirstAddress As String, strCol As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
rngBig.Replace what:="", replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
strCol = Left(c.Address(1, 0), InStr(c.Address(1, 0), "$") - 1)
Set rngAvg = .Range(strCol & "2:" & strCol & LRow)
dblAvg = WorksheetFunction.AverageIfs(rngAvg, _
.Range("A2:A" & LRow), .Range("A" & c.Row), _
.Range("B2:B" & LRow), .Range("B" & c.Row), _
.Range("C2:C" & LRow), .Range("C" & c.Row))
c.Value = dblAvg
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub
Click to expand...


I have pasted this code into your downloadable 300814 spreadsheet with
today's data and run the Sheet1.myAve macro. Some data gets changed,
but a lot of blank spaces and '-' remain.

I have posted today's data here. Just click on the data tab in Excel
and 'From Text' icon and import/finish/OK.

I have placed a copy here.

https://www.sendspace.com/file/lbb1t2
 
Hi John,

Am Sun, 31 Aug 2014 09:22:39 +0100 schrieb Saxman:
I have pasted this code into your downloadable 300814 spreadsheet with
today's data and run the Sheet1.myAve macro. Some data gets changed,
but a lot of blank spaces and '-' remain.
Click to expand...

in the apparently empty cells was not a nullstring but a space.
I improved the code:

Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range, rngAvg As Range
Dim dblAvg As Double
Dim FirstAddress As String, strCol As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:="*-*", replacement:=0, lookat:=xlWhole
rngBig.Replace what:=Chr(32), replacement:=0, lookat:=xlWhole
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
strCol = Left(c.Address(1, 0), InStr(c.Address(1, 0), "$") - 1)
Set rngAvg = .Range(strCol & "2:" & strCol & LRow)
dblAvg = WorksheetFunction.AverageIfs(rngAvg, _
.Range("A2:A" & LRow), .Range("A" & c.Row), _
.Range("B2:B" & LRow), .Range("B" & c.Row), _
.Range("C2:C" & LRow), .Range("C" & c.Row))
c.Value = dblAvg
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub


Regards
Claus B.
 
Hi John,

Am Sun, 31 Aug 2014 09:22:39 +0100 schrieb Saxman:


in the apparently empty cells was not a nullstring but a space.
I improved the code:

Sub myAvg()
Dim LRow As Long
Dim c As Range, rngBig As Range, rngAvg As Range
Dim dblAvg As Double
Dim FirstAddress As String, strCol As String

On Error Resume Next
With ActiveSheet
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:="*-*", replacement:=0, lookat:=xlWhole
rngBig.Replace what:=Chr(32), replacement:=0, lookat:=xlWhole
rngBig.Replace what:=0, replacement:="-", lookat:=xlWhole
Set c = rngBig.Find("-", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
strCol = Left(c.Address(1, 0), InStr(c.Address(1, 0), "$") - 1)
Set rngAvg = .Range(strCol & "2:" & strCol & LRow)
dblAvg = WorksheetFunction.AverageIfs(rngAvg, _
.Range("A2:A" & LRow), .Range("A" & c.Row), _
.Range("B2:B" & LRow), .Range("B" & c.Row), _
.Range("C2:C" & LRow), .Range("C" & c.Row))
c.Value = dblAvg
Set c = rngBig.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
rngBig.NumberFormat = "0"
End With
End Sub
Click to expand...

That works fine Claus. Thank you very much. I assume it is still
necessary to include 'End' (which I have done) at the end of each column
to prevent looping?
 
Hi John,

Am Sun, 31 Aug 2014 10:22:35 +0100 schrieb Saxman:
That works fine Claus. Thank you very much. I assume it is still
necessary to include 'End' (which I have done) at the end of each column
to prevent looping?
Click to expand...

no, End is not needed anymore because now there is no loop but the find
method and the range "rngBig" is set correctly.


Regards
Claus B.
 
Hi John,

Am Sun, 31 Aug 2014 10:22:35 +0100 schrieb Saxman:


no, End is not needed anymore because now there is no loop but the find
method and the range "rngBig" is set correctly.
Click to expand...

Thank you again Claus. It's been very interesting following the
'project' and watch it develop. I sometimes think it's embarrassing
asking group members for 'too much'.

I really appreciate what you have done for me. It does show how
powerful Excel is.
 
Hi John,

Am Sun, 31 Aug 2014 10:44:42 +0100 schrieb Saxman:
Thank you again Claus. It's been very interesting following the
'project' and watch it develop. I sometimes think it's embarrassing
asking group members for 'too much'.
Click to expand...

you are welcome. Always glad to help


Regards
Claus B.
 
Back
Top