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.

 

[footoo]

.

 

[Swayzy]

Try putting application.screenupdating = False at the start and re set it to true at rhe bottom

 

[footoo]

With help of the macro recorder :
• Filter to display the zeroes
• Go to visible cells only
• Clear contents
• Remove the filter

 

[DavidExcel]

What does this do exactly?

 

[DavidExcel]

Try putting application.screenupdating = False at the start and re set it to true at rhe bottom

What does this do exactly?

 

[footoo]

What does this do exactly?

https://www.google.com/search?q=app...hrome.0.0l6.6687j0j8&sourceid=chrome&ie=UTF-8

 

[Fazza]

You're right, the coding is definitely not the most efficient approach. Better may be to not put the zeros there at all. They presumably are created by the Evaluate applying to blank cells. One simple alternative to modify the current code

EndPrice.Cells.Replace What:=0, Replacement:=vbNullString, LookAt:=xlWhole

 

[DavidExcel]

You're right, the coding is definitely not the most efficient approach. Better may be to not put the zeros there at all. They presumably are created by the Evaluate applying to blank cells. One simple alternative to modify the current code

EndPrice.Cells.Replace What:=0, Replacement:=vbNullString, LookAt:=xlWhole

Sorry for the basic question, but where does this go?
Should I replace the evaluate line with that?

 

[Fazza]

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??