Attachment 462
Hi,
Select the two ranges and run the code.
Code:Sub Average2Range()
Dim r As Range
Dim a As String
Dim i As Long
Dim c As Long
Dim v
Set r = Selection
a = r.Address(0, 0)
v = Split(a, ",")
If Range(v(0)).Rows.Count <> Range(v(1)).Rows.Count Then
MsgBox "Row count must be same"
Exit Sub
ElseIf Range(v(0)).Columns.Count <> Range(v(1)).Columns.Count Then
MsgBox "Column count must be same"
Exit Sub
End If
With r.Parent
For i = 1 To .Range(v(0)).Rows.Count
For c = 1 To .Range(v(0)).Columns.Count
.Range(v(0)).Cells(i, c) = Evaluate("iferror(average(" & .Range(v(0)).Cells(i, c).Address(0, 0) & "," & .Range(v(1)).Cells(i, c).Address(0, 0) & "),"""")")
Next
Next
End With
End Sub
Dear Mr. Admin,
Looking at this code has made me realize how little I really know about vba. It's like another world out there. Thank you so much for sharing your gift. It works perfectly.
Steve
Let's see if we can "blow your mind" then.:silly: Here is a non-looping macro that I am pretty sure does what Admin's code does (although it asks you to pick or specify the ranges dynamically as opposed to making you select them first plus it does not require the two ranges to have the same number of rows)...Quote:
Originally Posted by SDruley
Note: I should point out that the code assumes no data exists below the end of Range A or above the beginning of Range B. Hopefully that is how your data is set up (if not, let me know and I will see if I can modify the code to make it ignore data outside of the specified ranges).Code:Sub AverageRanges()
Dim FirstRow As Long, LastRow As Long
Dim AddrA As String, AddrB As String
Dim RngA As Range, RngB As Range, RowRng As Range
Set RngA = Application.InputBox("Select Range A", Type:=8) 'Range("C6:F10")
Set RngB = Application.InputBox("Select Range B", Type:=8) 'Range("I9:L13")
FirstRow = RngA(1).Row
LastRow = RngB(1).Offset(RngB.Rows.Count).Row - 1
AddrA = Intersect(Rows(FirstRow & ":" & LastRow), Columns("C:F")).Address
AddrB = Intersect(Rows(FirstRow & ":" & LastRow), Columns("I:L")).Address
Range(AddrA) = Evaluate("IF(" & AddrA & "=""""," & AddrB & ",IF(" & AddrB & _
"=""""," & AddrA & ",(" & AddrA & "+" & AddrB & ")/2))")
Range(AddrA).Replace 0, "", xlWhole
End Sub
I agree
Code:Sub M_snb()
[C9:F10] = [if(C9:F10<>"",if(I9:L10<>"",int((C9:F10+I9:L10)/2),C9:F10),I9:L10)]
End Sub
The only problem I have with your submission is the use of those square brackets... they are slower than using Range and Evaluate (not really noticeably so in this particular instance though) and, more importantly, they are totally inflexible... you can't concatenate variables into them so they are only usable when you know for sure your ranges are totally locked down and will never change (which I do not think will be the case for the OP's ultimate use).Quote:
Originally Posted by snb
Rick,
Your code (in red) as it integrates with a snipet of my code. I am so greatful for this intricate and well devised code and the example it sets for the use of Evaluate, Intersect and xlWhole. I appreciate the opportunity to learn so much on a web site that has so many talented contributors.
SteveCode:Sub Freeze()
Dim Tt As Long
Dim Rb As Integer
Dim FirstRow As Long, LastRow As Long
Dim AddrA As String, AddrB As String
Dim RngA As Range, RngB As Range, RowRng As Range
Application.ScreenUpdating = False
On Error Resume Next
Sheets("INVESTOR INTERFACE").Activate
Application.Calculation = xlCalculationManual
With Sheets("INVESTOR INTERFACE")
'FREEZE/STORE TICK-CITY DATABASE
Let Tt = Application.Range("WHERE15").Value
Let Rb = Application.Range("reachBACK").offset(0, -1).Value
If Rb > Tt - 3 Then Rb = Tt - 4
If Rb = 0 Then
Exit Sub
End If
Set RngA = Sheets("INVESTOR INTERFACE").Range(.Cells(Tt, 128).offset(-Rb, 0), .Cells(Tt, 130))
Set RngB = RngA.offset(0, 13)
FirstRow = RngB(1).Row
LastRow = RngA(1).offset(RngA.Rows.Count).Row - 1
AddrA = Intersect(Rows(FirstRow & ":" & LastRow), Columns("DX:DZ")).Address
AddrB = Intersect(Rows(FirstRow & ":" & LastRow), Columns("EK:EM")).Address
Range(AddrB) = Evaluate("IF(" & AddrB & "=""""," & AddrA & ",IF(" & AddrA & _
"=""""," & AddrB & ",(" & AddrB & "+" & AddrA & ")/2))")
Range(AddrB).Replace 0, "", xlWhole
' Erase formulas on this passing train so cells don't have to be calculated [35,000 rows]
If Tt > 12 Then RngA.offset(-11, 0).Resize(24, 3).ClearContents
End With
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
End Sub
@Rick
Although the OP did't ask for any flexibility, I think it's the most flexible one:
If you 'abhorr' square brackets, useCode:Sub M_snb()
Range("C9:F10").Name = "snb1"
Range("I9:L10").Name = "snb2"
[snb1] = [if(snb1*snb2>0,int((snb1+snb2)/2),if(snb1&snb2="","",snb1+snb2))]
End Sub
@SteveCode:Range("snb1") = Evaluate("if(snb1*snb2>0,int((snb1+snb2)/2),if(snb1&snb2="""","""",snb1+snb2))")
Avoid activate in VBA.
The use of 'Let' is redundant in VBA.
I tried to incorporate my suggestion into your snippet:
Code:Sub Freeze()
Dim Tt As Long
Dim Rb As Integer
Tt = Application.Range("WHERE15").Value
Rb = Application.Range("reachBACK").Offset(0, -1).Value
If Rb > Tt - 3 Then Rb = Tt - 4
If Rb <> 0 Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("INVESTOR INTERFACE")
.Cells(Tt - Rb, 128).Resize(Rb, 3).Name = "snb1"
.Range("snb1").Offset(, 13).Name = "snb2"
[snb1] = [if(snb1*snb2>0,int((snb1+snb2)/2),if(snb1&snb2="","",snb1+snb2))]
If Tt > 12 Then .Range("snb1").Offset(-11, 0).Resize(24, 3).ClearContents
End With
Application.Calculation = xlCalculationAutomatic
End If
End Sub
snb and Rick,
Just tested snb's latest submission.
Both coding submissions work nicely. Both take about the same amount of time to run and both are clearly brilliant examples that I certainly could not get from anyone else.
snb, thank you for providing an integrated view of your code, very helpful and well done.
Thank you Europe and the United States
Steve
Quote:
Originally Posted by snb
Excellent! I don't know why, but I keep forgetting about using Defined Names for simplification... and yes, that does make it more flexible.:applause: One suggestion though... delete the Defined Names you create after they are no longer needed in the code so they do not get "locked in" when the user saves his/her workbook.Quote:
Originally Posted by snb
Yes, I know I can do that... as a matter of fact, that is what I did (except for the Defined Names part, of course). Actually, with using Defined Names, I might reconsider by objection to the square bracket (at least as it applies to substituting for the Evaluate function call).:surprise:Quote:
Originally Posted by snb