Sum range composing of text and numbers

[MikeL2023]

Hi guys,

I have a bit of VBA that works, but seems wasteful, and I was hoping someone might be able to help me optimise it a bit, or suggest better ways to achieve the same result.

Sub CalcAT()

Dim val As Range
Dim airtotal As Double
Dim aircount As Double
Dim AvAT As Double

For Each val In Sheets("Data Entry").Range("AQ22:AQ1521").Cells
If IsEmpty(val.Value) = False Then
If Application.WorksheetFunction.IsNumber(val.Value) = True Then
airtotal = airtotal + val.Value
aircount = aircount + 1
Else
airtotal = airtotal + CDbl(Left(val.Value, 5))
aircount = aircount + 1
End If
End If
Next

AvAT = Round((airtotal / aircount), 2)
Sheets("Calculations").Range("I14").Value = AvAT

End Sub

This is related to air tightness testing as part of the UK Building Regs (hence the multiple references to 'AT' and 'air').

Currently this runs through range 'AQ22:AQ1521" on the Data Entry sheet, however this is actually a dynamic range so it seems needless to run through the full range each time.

This range contains a pasted list of values exported from some proprietary software to a csv in a fixed format. The values can either be numeric or strings, with the strings always being a number (to 2 dp) followed by a space and the word 'assumed' in brackets. E.g. 15.00 (assumed)

The sub checks first if the cell is empty and if not, then checks if its numeric. If it is it adds the number to a running sum. If not, then it converts the number part of the string and adds that. It also counts each non-empty cell in the range.

Finally once the loop is done, it divides one by the other to get the average and writes it to cell 'I14' on the 'Calculations' sheet.

Can anyone take a look and suggest better ways of achieving this?

 

[Michael M]

Modified to code to find the last row in AQ....but some sample data would make it easier to possibly modify further.

Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each val In Sheets("Data Entry").Range("AQ22:AQ" & lr)

 

[Z51]

This code finds the last used cell in AQ, loops through only the cells with text values between AQ22:AQ(lastrow) and converts them to numbers, then sums and averages the resulting values, less the count of any blank cells in the range.

Sub MikeL()
Dim lastrow As Long, ce As Range, ws As Worksheet, rng As Range
Set ws = Sheets("Data Entry")
lastrow = ws.Range("AQ" & Rows.Count).End(xlUp).Row
Set rng = ws.Range("AQ22:AQ" & lastrow)

For Each ce In rng.SpecialCells(xlCellTypeConstants, 2)
    ce.Value = CDbl(Left(ce.Value, 5))
Next ce

Sheets("Calculations").Range("I14").Value = _
    Round(WorksheetFunction.Sum(rng) / (lastrow - 21 - rng.SpecialCells(xlCellTypeBlanks).Count), 2)
End Sub