Replace cell if value of cell offset

dirtydan - May 10, 2010 at 06:14 AM
 dirtydan - May 14, 2010 at 10:51 AM
I have been trying to copy a report from HTML into excel and have run into several problems. First off the numbers have two blanks after them and every solution I have found always leaves one behind. I found a 3rd party add-on that does the trick but I don't think I can install it at work. Any other suggestions would be great.

More importantly though I have a column of numbers that any value over 98.44 is formatted green and left blank. I want to replace the blanks with either 98.44 or 100 based upon the value of the cell 4 columns over being greater to 0 or equal to 0. I know that it should be fairly easy but I can't get it to function correctly. If I could get it to select column B where the blanks are that would be great also.

2 replies

rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
May 10, 2010 at 11:42 PM
Could you please zip up sample html and resulting excel file and upload on some shared site like and post back here the link to allow better understanding of how it is now and how you foresee.
I actually looked around and pieced together the coding that I needed. I tried several to trim the cells and only found this that did the trick that I needed. As far as the replace if I had the coding right but was trying to run it on a sheet where the data not "trimmed" so it was not able to calculate correctly as it was recognizing the numbers as text. Here is the coding for anyone in a similar situation.

' This starts trim of all cells

Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'This replaces blanks with %

For myRow = 1 To 140
If Cells(myRow, 2).Value = "" And Cells(myRow, 6).Value = 0 Then
Cells(myRow, 2).Value = 100
End If
If Cells(myRow, 2).Value = "" And Cells(myRow, 6).Value > 0 Then
Cells(myRow, 2).Value = 98.44
End If
Next myRow