macro to find, caculate and replace data

[swallis]

I have a sheet (Excel 2003) which lists sales by product. the "amount" column (e) is in tonnes (1000kg) - except when the product code no in "name" column (b) includes a number of kg, when the "amount" is no of units. Each product can have 1 or more sales listed in rows, then a row for the total amount of the product and blank rows in between. My next macro deletes all rows, other than the totals. I need a macro to change totals that are units to tonnes.

Any assistance would be appreciated. I will attach a sample of the data

Steve

[swallis]

Sub ToTonnes()
Dim s As String
Dim v As Variant
Dim I As Integer
Dim Factor As Long
Dim ws As Worksheet
Dim RowNo As Long

Set ws = ActiveSheet

For RowNo = 1 To ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

s = ws.Cells(RowNo, "B")
If Val(Left(s, 1)) > 0 Then 'If the "Name" Col Cell starts with a number, look for "kg"
Factor = 0 'Default to Zero
If InStr(s, "kg") > 0 Then
v = Split(s)
For I = 1 To UBound(v)
If InStr(v(I), "kg") Then
Factor = Val(v(I))
Exit For
End If
Next I
End If
ElseIf InStr(ws.Cells(RowNo, "D"), "Total") > 0 Then 'Check to determine if the current line is the "Total" line
If Factor > 0 Then
With Cells(RowNo, "e")
.Value = (Factor * ws.Cells(RowNo, "E")) / 1000
.NumberFormat = "0.00"
End With
End If
End If
Next RowNo


End Sub