DavidExcel
New Member
- Joined
- Feb 12, 2019
- Messages
- 10
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?
Thanks for the help.
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?
Code:
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.