Average Value Revisited

S

Saxman

Claus kindly wrote the code below which works fine. I would like it to
average out columns AJ and AF.

I've had a go at it, but coding is not my forte.


Option Explicit

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
 
C

Claus Busch

Hi John,

Am Sat, 06 Sep 2014 10:57:58 +0100 schrieb Saxman:
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
Click to expand...

then change the rngBig:
Set rngBig = Application.Union(.Range("AJ1:AJ" & LRow), _
.Range("AF1:AF" & LRow))


Regards
Claus B.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 10:57:58 +0100 schrieb Saxman:


then change the rngBig:
Set rngBig = Application.Union(.Range("AJ1:AJ" & LRow), _
.Range("AF1:AF" & LRow))
Click to expand...


I would like,

Set rngBig = Application.Union(.Range("AJ1:AJ" & LRow), _
.Range("AF1:AF" & LRow))

in addition to,

Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))

Not sure where to place it?
 
C

Claus Busch

Hi John,

Am Sat, 06 Sep 2014 15:18:03 +0100 schrieb Saxman:
Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AE" & LRow), .Range("AK1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
Click to expand...

then try:

Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AF" & LRow), .Range("AJ1:AQ" & LRow), _
.Range("AX1:AX" & LRow))


Regards
Claus B.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 15:18:03 +0100 schrieb Saxman:


then try:

Set rngBig = Application.Union(.Range("X1:X" & LRow), _
.Range("Z1:AF" & LRow), .Range("AJ1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
Click to expand...


I have tried this. Everything works except for column AJ (TnrFrm).

The code looks fine though.

I've put a copy of today's data here if you find it useful.


https://www.sendspace.com/file/tn7bl4
 
C

Claus Busch

Hi John,

Am Sat, 06 Sep 2014 15:49:45 +0100 schrieb Saxman:
I have tried this. Everything works except for column AJ (TnrFrm).
Click to expand...

in column AJ the cells are blank. But the other cells that looked like
blank had spaces. So you must replace the blank cells with 0 also:

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:AF" & LRow), .Range("AJ1: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:="", 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.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 15:49:45 +0100 schrieb Saxman:


in column AJ the cells are blank. But the other cells that looked like
blank had spaces. So you must replace the blank cells with 0 also:

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:AF" & LRow), .Range("AJ1: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:="", 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. I forgot about the blanks.

You made my day.

Thank you so much again.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 15:49:45 +0100 schrieb Saxman:


in column AJ the cells are blank. But the other cells that looked like
blank had spaces. So you must replace the blank cells with 0 also:

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:AF" & LRow), .Range("AJ1: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:="", 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...

Sorry Claus, but I just ran this through and it's giving me the average
of all those entries in each sequence in column AJ, rather than the
average for the missing values. I need the blanks to be given the
average for each sequence.

This sequence needs to be that further down below.
43
53
67
100
58
42
57

52
57
57
27
75




43
53
67
100
58
42
57
57
52
57
57
27
75
 
C

Claus Busch

Hi John,

Am Sat, 06 Sep 2014 19:35:12 +0100 schrieb Saxman:
Sorry Claus, but I just ran this through and it's giving me the average
of all those entries in each sequence in column AJ, rather than the
average for the missing values. I need the blanks to be given the
average for each sequence.
Click to expand...

a sequence is described by date, time and city.
I loaded the file new and checked the sequences and the results. For me
the averages are all correct.


Regards
Claus B.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 19:35:12 +0100 schrieb Saxman:


a sequence is described by date, time and city.
I loaded the file new and checked the sequences and the results. For me
the averages are all correct.
Click to expand...

Sorry. You are right Claus. I just ran it on today's data and it's fine.

I remembered that the data I ran it on was not sorted as above.

You made my day again!
 
C

Claus Busch

Hi John,

Am Sat, 06 Sep 2014 20:04:12 +0100 schrieb Saxman:
Sorry. You are right Claus.
Click to expand...

no, you are right. I checked it again, highlighted all cell that should
be filled and made borders under a sequence and I saw some errors.
Please look here:
https://onedrive.live.com/?cid=9378...#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for "060914" and load it down.

Here is the new 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:AF" & LRow), .Range("AJ1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:="*-*", replacement:=0, lookat:=xlPart
rngBig.Replace what:=Chr(32), replacement:=0, lookat:=xlPart
rngBig.Replace what:="", replacement:=0, lookat:=xlPart
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.
 
S

Saxman

Hi John,

Am Sat, 06 Sep 2014 20:04:12 +0100 schrieb Saxman:


no, you are right. I checked it again, highlighted all cell that should
be filled and made borders under a sequence and I saw some errors.
Please look here:
https://onedrive.live.com/?cid=9378...#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for "060914" and load it down.

Here is the new 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:AF" & LRow), .Range("AJ1:AQ" & LRow), _
.Range("AX1:AX" & LRow))
rngBig.Replace what:="*-*", replacement:=0, lookat:=xlPart
rngBig.Replace what:=Chr(32), replacement:=0, lookat:=xlPart
rngBig.Replace what:="", replacement:=0, lookat:=xlPart
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.
Click to expand...


Thank you Claus. I have saved the file and the code. I will run this
Sunday morning. I will keep you informed.

Goodnight to you.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro 9
Array code only works on selected sheet 14
Change_Event not responding to change made by formula. 11
Marco Exits without error 1
Array macro question 4
VLookup in VBA Help Needed 9
Macro to Sum Two Adjacent Columns as per Text in previous Column 8
Copy Entire Row - Rick Rothstein ? 2

Top