PDA

View Full Version : code does run too slaow and too long



Pilot5000
08-02-2015, 12:45 AM
hi guys
i have the following code
Sub Cur_4()
Application.ScreenUpdating = False
Dim Currency_Symbol As String, CellFormat As String
Dim Percent As Boolean, FormatCell As Boolean
Dim myrange As Range, cell As Range
Dim startrow As Long, endrow As Long

Currency_Symbol = Worksheets("Data Input Area").Range("Q8")
Percent = (InStr(1, Currency_Symbol, "%") > 0)
Set myrange = Sheets("Data Input Area").Range("D9:R6000")

For Each cell In myrange
If IsNumeric(cell.Value) Then
CellFormat = cell.NumberFormat
If CellFormat <> "General" Then
FormatCell = False
If InStr(1, CellFormat, "%") = 0 And Not Percent Then FormatCell = True
If Abs(cell.Value) >= 1 And Not Percent Then FormatCell = True
If Abs(cell.Value) <= 1 And Percent Then FormatCell = True

If FormatCell Then
If Percent Then
cell.NumberFormatLocal = "0.0%;[Red]-0.0%"
Else
cell.NumberFormatLocal = Currency_Symbol & " #,##0.0;" & Currency_Symbol & " [Red](#,##0.0)"
End If
End If
End If
End If
Next
Application.ScreenUpdating = True

End Sub

my issue is that the when i run the code it take it too long to be completed , and more then once it cause the workbook to stop working ans shut off excel , no idea why, is that because the size of the range D9:R6000 that the code need to verify or what ?? is there any way to improve that code so it will not take it so long to run ?

p45cal
08-02-2015, 01:05 PM
cross post http://www.excelforum.com/excel-programming-vba-macros/1097027-code-running-to-slow-and-to-long.html

Paul_Hossler
08-02-2015, 05:40 PM
seems kind of round about -- what exactly are you trying to do?

You have almost 90K cells in the range, so it will take a little time. I suggest the DoEvents to give windows a chance to catch up





Sub Cur_4()
Application.ScreenUpdating = False

Dim Currency_Symbol As String, CellFormat As String
Dim Percent As Boolean, FormatCell As Boolean
Dim myrange As Range, cell As Range
Dim startrow As Long, endrow As Long

Currency_Symbol = Worksheets("Data Input Area").Range("Q8")
Percent = (InStr(1, Currency_Symbol, "%") > 0)
Set myrange = Sheets("Data Input Area").Range("D9:R6000")

For Each cell In myrange

If cell.Row Mod 100 = 0 Then DoEvents '<<<<<<<<<<<<<<

If IsNumeric(cell.Value) Then
CellFormat = cell.NumberFormat
If CellFormat <> "General" Then
FormatCell = False
If InStr(1, CellFormat, "%") = 0 And Not Percent Then '<<<<<<<<
FormatCell = True
ElseIf Abs(cell.Value) >= 1 And Not Percent Then '<<<<<<<
FormatCell = True
ElseIf Abs(cell.Value) <= 1 And Percent Then '<<<<
FormatCell = True
End If

If FormatCell Then
If Percent Then
cell.NumberFormatLocal = "0.0%;[Red]-0.0%"
Else
cell.NumberFormatLocal = Currency_Symbol & " #,##0.0;" & Currency_Symbol & " [Red](#,##0.0)"
End If
End If
End If
End If
Next

Application.ScreenUpdating = True

End Sub

Pilot5000
08-03-2015, 02:23 AM
Hi paul, thank you for your help , eventually i tried your suggestion but even with your version it still run long time , for your question what i need to do, so basically i have workbook that contain several sheets, in the sheet (Load Client Data") we centralized all the financial information from the client along with the analysis of that information. moreover, the range that cover all that data is from A2:V6000 , in that range i have 4 elements text, percentage, general numbers, and currency numbers, giving the fact that this workbook need to work in different languishes, it required appropriate currency symbol based on the languish that selected , englsih =US Dollar, French= Euro, England=pound, ect, and as you can see from the code all numbers that format as currency need to change to the appropriate currency symbol , and all the rest , (percentage , and general numbers ) should remain the same with not change , hope that i explained myslef clear, so that what i need but with my code as i mentioned it take it more then 30 decodes to run and most of the time it get stuck in the middle and the workbook shut down , if you see in the attached file , when i run the code on range up to 1000 cells it run fine and no problems , but my information is up to V6000 as i mentioned do i don't understand why it do that

Paul_Hossler
08-03-2015, 05:54 AM
I'd do it the other way

For Example, Cols F, H, J, and L I would in advance assign a Style = "LocalCurrency" and then just change the definition of the Style LocalCurrency to Symbol + etc. etc. with my macro

Same for "LocalPercentage"



Sub LocalFormatting()

Dim Currency_Symbol As String

Currency_Symbol = Worksheets("Data Input Area").Range("O6")

ActiveWorkbook.Styles("LocalCurrency").NumberFormatLocal = Currency_Symbol & " #,##0.0;" & Currency_Symbol & " [Red](#,##0.0)"
ActiveWorkbook.Styles("LocalPercentage").NumberFormatLocal = "0.0%;[Red]-0.0%"
End Sub




Small sample attached

Pilot5000
08-03-2015, 07:12 AM
hi Paul i placed your code in my original workbook in a module and tried to run your new code but i get the time error 9 subscript out of range on the following line: "ActiveWorkbook.Styles("LocalCurrency").NumberFormatLocal = Currency_Symbol & " #,##0.0;" & Currency_Symbol & " [Red](#,##0.0)"

Paul_Hossler
08-03-2015, 07:56 AM
Forgot to mention that you have to create it first :-( before you can update it

Other ways to do it, but this seemed the easiest

If you experiment with my simple attachment, you should get it

1. Create two new styles called LocalCurrency and LocalPercentage (CAPTURE.JPG)
2. Apply the styles to the money cells and the % cells (CAPTURE1.JPG)
3. Then when you change the definition of the Styles, the cell formatting will update (MACRO)

Pilot5000
08-04-2015, 10:55 PM
Hi Paul

thank you thank you thank you i finally done what you told me and it's superb and it work wonderful, excatly like i need, only one question if i need to work with the workbook on another coputer i have to Create two new styles called LocalCurrency and LocalPercentage again or not????
and again many thanks , where we can indicate here that this thread is solved ???

Paul_Hossler
08-05-2015, 07:23 AM
1. The 2 new styles are in the workbook, so taking the WB to another computer will take them with it

2. On your first post, top right there's [Thread Tools] and one of the options is [Mark Solved]