code does run too slaow and too long

[Pilot5000]

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]

cross post http://www.excelforum.com/excel-prog...d-to-long.html

[Paul_Hossler]

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]

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]

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]

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]

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]

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]

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]