Better way than "For Each... Next..." to replace 0s by blanks?

[DavidExcel]

I have wrote the code below, which has for objective to create a new file, which is a copy of the original one with the exception that prices are increased by a user define %.
I am not sure this the most efficient approach but it works.

The problem is actually with the last bit of code here (For Each... Next...). Since, there are so many lines, this takes forever.

Is there a better way to remove all 0 coming from the calculations and get blanks instead?

Private Sub IncreaseButton_Click()


    Dim FolderPath As String
    Dim FileName As String
    Dim FileCopyName As Variant


    FolderPath = Application.ActiveWorkbook.Path
    FileName = Application.ActiveWorkbook.Name
    
    FileCopyName = InputBox("Please enter the new file name after the price increase. It will be saved in the same folder." & vbCrLf & " " & vbCrLf & "Be aware that the Deal # and the validity dates will also be deleted from the new file.")
    
    If FileCopyName = "" Then
    MsgBox "DRF Creation Canceled"
    Exit Sub
    End If
    
    Dim IncOrDec As Variant
    IncOrDec = InputBox("Enter the percentage of Increase or Decrease without the % sign")
    
    If IncOrDec = "" Then
    MsgBox "The new DRF file cannot be created without a Value."
    Exit Sub
    End If
    
    If Not IsNumeric(IncOrDec) Then
    MsgBox "The new DRF file cannot be created without a numeric Value." & vbCrLf & "(Percentage value without the % sign)"
    Exit Sub
    End If
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs (FolderPath & "\" & FileCopyName & ".XLSM")
       
    Dim StartFile As Excel.Workbook
    Set StartFile = Workbooks.Open(FolderPath & "\" & FileName)
    Dim EndFile As Excel.Workbook
    Set EndFile = Workbooks.Open(FolderPath & "\" & FileCopyName & ".XLSM")
    
    Dim StartPrice As Range
    Set StartPrice = StartFile.Worksheets("DRF").Range("D42:D10041")
    'Will need to be updated in final version
       
    Dim EndPrice As Range
    Set EndPrice = EndFile.Worksheets("DRF").Range("D42:D10041")
    'Will need to be updated in final version
       
    EndPrice = Evaluate(StartPrice.Address & "* (1+" & IncOrDec & "/100)")
        
[B]    For Each cell In EndPrice[/B]
[B]    If cell.Value = "0" Then cell.Value = Blank[/B]
[B]    Next[/B]
            
End Sub

Thanks for the help.

 

[DavidExcel]

It replaces the text in bold in the first post, David - as a better way than "for each... next ..." to replace 0s by blanks.
Did you write the code??

OK, got it. It works. Thanks,

You can say I wrote the code, but I actually mixed some knowledge I had about Macros and research from the internet, combining multiple resources.

 

[Fazza]

Good work then, David. Keep on learning. Hope the replace line works for you. regards, Fazza