Results 1 to 14 of 14
  1. #1
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Bogangar NSW Australia
    Posts
    154
    Thanks
    29
    Thanked 3 Times in 2 Posts

    Excel 2010 Hangs with Problem Event Name: AppHangB1

    I am using VBA in Excel to clean up an imported CSV file with nearly 10000 rows of data.

    Sometimes the procedure runs to completion without hanging Other times it gets about 6% through the rows and Hangs Still other times it might make it to 50% or 80% or some other apparently arbitrary percentage before hanging

    When it hangs my only recourse is to hit the Close icon ("x" at top-right of the Exel window) which brings up the helpful (I don't think) "Microsoft Excel is Not Responding" dialogue with the following report:
    Description:
    A problem caused this program to stop interacting with Windows.

    Problem signature:
    Problem Event Name: AppHangB1
    Application Name: EXCEL.EXE
    Application Version: 14.0.7168.5000
    Application Timestamp: 56eade71
    Hang Signature: 51b9
    Hang Type: 256
    OS Version: 6.1.7601.2.1.0.256.48
    Locale ID: 3081
    Additional Hang Signature 1: 51b9b6073c36dc56d3f2228e63c51b26
    Additional Hang Signature 2: 9712
    Additional Hang Signature 3: 9712c99c6300efb4d926c2dbcbed9b2d
    Additional Hang Signature 4: 51b9
    Additional Hang Signature 5: 51b9b6073c36dc56d3f2228e63c51b26
    Additional Hang Signature 6: 9712
    Additional Hang Signature 7: 9712c99c6300efb4d926c2dbcbed9b2d

    Below is the VBA procedure I'm running. I initially tested it with about 500 rows of data and it worked perfectly every time. It's only when I import my large csv data file with about 10,000 rows that the hanging occurs.

    Code:
    Public Sub CleanCSVData()
    
    
    Dim iLastRow As Long
    Dim sht As Worksheet
    Dim iRowCount As Long
    Dim iColumnCount As Long
    
    
    Dim Msg, Button, Title, Response As String
    
    
    On Error GoTo ErrorMessages
    
    
    Button = vbExclamation
    Title = "Public Sub CleanCSVData()..."
    
    
    On Error GoTo ErrorMessages
    
    
    '   Turn OFF Screen updating
    Application.ScreenUpdating = False
    
    
    '   **** Determine Last Row number
    Set sht = Worksheets("CSV Input Data")
    iLastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    
    
    '   Check is Ephemeris is Heliocentric or Geocentric
    For iRowCount = 1 To 20
        If sht.Range("A" & iRowCount) = "heliocentric" Then
            Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Heliocentric"
            Exit For
        Else
            Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Geocentric"
        End If
    Next
    
    
    '   **** Start data cleanup process
    
    
    For iRowCount = 1 To iLastRow
    
    
        '   Test for unnecessary data in row
        With sht
        Select Case .Range("A" & iRowCount)
            Case "SWISS"
                .Range("A" & iRowCount & ":" & "Z" & iRowCount).ClearContents
            Case "heliocentric"
                .Range("A" & iRowCount & ":" & "Z" & iRowCount).ClearContents
            Case "Delta"
                .Range("A" & iRowCount & ":" & "Z" & iRowCount).ClearContents
            Case "page"
                .Range("A" & iRowCount & ":" & "Z" & iRowCount).ClearContents
        End Select
      
            
            If Left(.Range("A" & iRowCount), 3) = "D:\" Then .Range("A" & iRowCount & ":" & "Z" & iRowCount).ClearContents
            If Trim(.Range("B" & iRowCount)) = "Sid.t" Then
                .Range("B" & iRowCount & ":" & "M" & iRowCount).Cut Destination:=.Range("E" & iRowCount)
            End If
            If .Range("A" & iRowCount) = "Day" Then
                .Range("A" & iRowCount).Cut Destination:=.Range("B" & iRowCount)
            End If
            If Len(.Range("A" & iRowCount)) = 3 And UCase(.Range("A" & iRowCount)) <> "MAY" Then
                .Range("B" & iRowCount & ":" & "O" & iRowCount).Cut Destination:=.Range("C" & iRowCount)
                .Range("B" & iRowCount).Value = Trim(Right(.Range("A" & iRowCount), 2))
                .Range("A" & iRowCount).Value = Left(.Range("A" & iRowCount), 1)
            End If
            .Range("B" & iRowCount).Value = Trim(.Range("B" & iRowCount).Value)
            For iColumnCount = 6 To 15
                If Len(Trim(.Cells(iRowCount, iColumnCount))) < 6 And Len(Trim(.Cells(iRowCount, iColumnCount))) >= 3 And _
                    Not Trim(.Cells(iRowCount, iColumnCount)) = "Terra" Then
                    .Cells(iRowCount, iColumnCount).Value = Trim(.Cells(iRowCount, iColumnCount) & "'00")
                Else
                    .Cells(iRowCount, iColumnCount).Value = Trim(.Cells(iRowCount, iColumnCount))
                End If
            Next
    
    
        End With
        
        '   Clear Clipboard after Cut & Paste
        Application.CutCopyMode = False
        
        '   Display Processing progress in Status Bar
        Application.StatusBar = "Clean CVS Data Progress: " & iRowCount & " of " & iLastRow & ": " & Format(iRowCount / iLastRow, "0%")
        
    Next
    
    
    '   Clear Status Bar Progress Status
        Application.StatusBar = False
    
    
    '   Turn ON screen updating
        Application.ScreenUpdating = True
        
    Exit Sub
    
    
    ErrorMessages:
    
    
        Msg = "Error #:  " & Str(Err.Number) & " was generated by " & Err.Source & vbCrLf & _
              "Error Line:  " & Erl & vbCrLf & _
              Err.Description
        Response = MsgBox(Msg, Button, Title)
    
    
    End Sub
    The hanging occurs when running through the "For iRowCount = 1 To iLastRow .... Next" loop.

    I have a similar procedure that that runs through the same sheet/rows as the above procedure to modify the data and write it to a new sheet which has never hung up on me

    Incidentally I'm running MS Office 2010 32 bit under Windows 7 Ultimate 64 bit (both fully updated).

    I hope that some-one has a clue as to what's going on and how to fix it.

    Thanks in anticipation.


    BygAuldByrd

  2. #2
    5 Star Lounger
    Join Date
    Jan 2004
    Location
    Praha
    Posts
    990
    Thanks
    56
    Thanked 105 Times in 90 Posts
    Excel may be running out of resources.

    What happens if you split up the code so it does 1,000 rows then exits. Then the next 1,000 etc.

  3. #3
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi BygAuldByrd

    A quick and simple solution is probably to 'chunk' the processing as Martin suggests, i.e. in 'chunks' of 1000 rows.
    So you create an 'outer loop' (1 to 10) and an 'inner loop' (processing 1000 rows).

    However, looking at what you are doing (by examining your code), you could probably do the job more efficiently (and quicker) using other techniques. Like, instead of processing row-by-row (slow), you could probably 'sort' the data, and process 'blocks of rows'. Then return the original to the same sort row-order etc etc etc

    zeddy

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    BAB,

    You might also want to set Calculation to Manual at the beginning of the procedure. HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. #5
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Bogangar NSW Australia
    Posts
    154
    Thanks
    29
    Thanked 3 Times in 2 Posts
    Thanks for the prompt responses and suggestions.

    Excel shouldn't be running out of resources as my computer has 15.6GB of useable RAM with an IntelCore i7 CPU.

    I seriously doubt that cutting the process into 1000 row chunks will work. As I've already indicated, the process has hung after only 6% of the rows were complete, ie 6% of 10,000 which is a mere 600 rows. There must be a more fundamental reason for the issue. Also, if that were the solution the limitation would be a major defect in Excel, an application that can supposedly handle 10s, if not 100s, of thousands of rows of data.

    In the five test runs conducted after setting Calculation to Manual the process hung at 5%, 12%, 7% and 81%, with only 1 successful completion. Hardly encouraging

    So obviously the problem remains.

    After one of those test runs while attempting to shutdown Excel I received the following dialogue:


    After this message the only way I could Kill Excel was by "End Process" in Task Manager.

    As there are numerous instances of a cut/paste process in this procedure, this looks like it could just be where the processing stopped on this one occasion, as I've been unable to find any errors in the .Range.cut coding.

    The clue to the issue is probably in the error message Description: "A problem caused this program to stop interacting with Windows." I've googled the "Problem Event Name: AppHangB1" but as yet haven't found anything conclusive as to the cause and no definitive solution. Seems I need to keep searching.

    Experimenting: I have an old old computer with an Intel core2 6320 @ 1.8GHz single core CPU running Windows 10 Pro with 2GB RAM and Excel 2007. On this computer the process runs, but Status Bar "Clean CSV DATA Progress:..." indication disappears after around 15% to 20%, Excel indicates it is "Not Responding", but in fact keeps processing (Task Manager reports CPU at ≈80%, Excel process at ≈35%) and after waiting a while Excel "returns to life" and the process has successfully completed running. I've run the test 10 times on this computer, nearly always with the succesful result. On one occasion I received the following error dialogue:


    Clicking "Continue" showed the process had completed successfully regardless of that error dialogue.

    The full report from this error dialogue is:


    See the end of this message for details on invoking
    just-in-time (JIT) debugging instead of this dialog box.

    ************** Exception Text **************
    System.Runtime.InteropServices.ExternalException (0x800401D0): Requested Clipboard operation did not succeed.
    at System.Windows.Forms.Clipboard.ThrowIfFailed(Int32 hr)
    at System.Windows.Forms.Clipboard.GetDataObject(Int32 retryTimes, Int32 retryDelay)
    at System.Windows.Forms.Clipboard.GetDataObject()
    at System.Windows.Forms.Clipboard.ContainsText(TextDa taFormat format)
    at System.Windows.Forms.Clipboard.ContainsText()
    at MouseWithoutBorders.FormHelper.WndProc(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.O nMessage(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.W ndProc(Message& m)
    at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)


    ************** Loaded Assemblies **************
    mscorlib
    Assembly Version: 4.0.0.0
    Win32 Version: 4.6.1078.0 built by: NETFXREL3STAGE
    CodeBase: file:///C:/Windows/Microsoft.NET/Framework/v4.0.30319/mscorlib.dll
    ----------------------------------------
    MouseWithoutBordersHelper
    Assembly Version: 1.0.0.1
    Win32 Version: 1.0.0.1

    I've only seen this error dialogue once, and accordingly have not been able to invoke "just-in-time" debugging.

    Does this provide any useful clues to resolving this issue?

    Thanks again

    BygAuldByrd

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    BAB,

    10K rows but how many Columns? Are you using 32 or 64 bit Excel?

    You could try a Save every so many rows which would also clean out some of the resources like the undo buffer. Yes, this will slow down the process but if it let's it run to completion...

    I notice you are using:
    Code:
     .Range("A" & iRowCount)
    Quite a bit you may want to try:
    Code:
     .Cells(iRowCount,["A"])
    It may or may not be more efficient?

    While we're throwing things at Excel to see what will stick I noticed that you are using an Integer type (max 32,767 for the row reference since even in 32 bit Excel the rows exceed an integer you might want to change it to a Long?
    vbainteger.PNG

    Don't know if any of this will help but as you seem to currently be out of options...

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. #7
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Bogangar NSW Australia
    Posts
    154
    Thanks
    29
    Thanked 3 Times in 2 Posts
    Hi RetiredGeek,

    I'm running 32 bit Excel 2010 on windows 7 Ultimate 64 bit.

    Data is contained in about 10,000 rows and 17 columns.

    I can't work out where you saw "Integer" because "Find" never found it in that procedure. I generally use "Long" for the very reason that the range of numbers in "Integer" is limited to -32768 to +32767

    I've changed all instances of the ".Range("A" & iRowCount)" to ".Cells(iRowCount,1)" and ".Range("B" & iRowCount)" to ".Cells(iRowCount,2)", but the problem persists

    I'm unsure of what you mean by "You could try a Save every so many rows which would also clean out some of the resources like the undo buffer. Yes, this will slow down the process but if it let's it run to completion...". Do you mean save the workbook frequently, or some other technique?

    Googling around I came across http://www.mrexcel.com/forum/excel-q...%3D-false.html which discusses the potential benefits of turning OFF Workbook/Sheet Event Handling.

    Code:
     
        '     Turn OFF Application Events
        Application.EnableEvents = False
        
        '     Turn ON Application Events
        Application.EnableEvents = True
    Figured it couldn't hurt to give it a try

    Looks like it might have resolved the issue

    I've done about 10 test runs with the above codes in my procedure and the results have consistently been:
    • Procedure runs, showing the progress in the Status Bar until it reaches about 19% to 22%,
    • Excel then reports it is "Not Responding" and the cursor becomes an hour-glass (Task Manager shows Excel is still working, albeit slowly), then
    • Waiting patiently for about 30 to 60 seconds, the procedure completes just as it should


    Now it looks like I can continue developing the code that I require to do what I want this workbook to eventually do


    Thanks for your assistance.

    BygAuldByrd

  8. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    BAB,

    Quote Originally Posted by BygAuldByrd View Post
    Hi RetiredGeek,
    I can't work out where you saw "Integer" because "Find" never found it in that procedure. I generally use "Long" for the very reason that the range of numbers in "Integer" is limited to -32768 to +32767
    d
    My bad for not looking further. I "assumed" you were using Hungarian Notation, e.g. iRowCount meaning Integer Row Count.

    As for the saving, yes saving the workbook with code something like this:
    Code:
       lSaveCount =  500      '*** Change as necessary to adjust performance***
    
       For lRowCount = 1 To lLastRow
    
        .... your code here  ...
    
         If ((lRowCount Mod lSaveCount) = 0) Then ActiveWorkbook.Save
    
      Next lRowCount
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  9. #9
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi BygAuldByrd

    It would be useful to have a sample of the csv data, but in the meantime, perhaps you could try out my modified code:
    Code:
    Public Sub CleanCSVData()
    
    Dim zSheetName As String        'used for current sheet name
    Dim zLastRow As Long            'used for last used row number
    Dim temp As String              'used for temp range address; e.g. "A3456:Z3456"
    Dim zValue                      'variant; used for cell contents
    
    Dim r As Long                   'used as row counter
    Dim c As Long                   'used as column counter
    
    Dim Msg As String               'used for message box text
    Dim Button As Long              'used for message box buttons
    Dim Title As String             'used for message box heading
    Dim Response As Long            'used to capture what User clicked in message box
    
    On Error GoTo ErrorMessages                         'set error trapping
    
    With Application                                    'use shortcut
        .ScreenUpdating = False                         'turn OFF Screen updating for speedup
        .Calculation = xlCalculationManual              'turn Calcs OFF for speedup
        .EnableEvents = False                           'turn event trapping OFF for speedup
    End With
    
    zSheetName = ActiveSheet.Name                       'save for later return
    Worksheets("CSV Input Data").Select                 'switch to CSV import sheet
    
    zLastRow = Cells(Rows.Count, "A").End(xlUp).Row     'Determine Last Row number
    
    'Check is Ephemeris is Heliocentric or Geocentric
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For r = 1 To 20                                     'check within first 20 rows
        If Cells(r, 1) = "heliocentric" Then
            Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Heliocentric"
            Exit For                                    '
        Else
            Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Geocentric"
        End If
    Next
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    '   **** Start data cleanup process
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For r = 1 To zLastRow
        temp = "A" & r & ":Z" & r                           'e.g. "A2438:Z2438"
        zValue = Cells(r, 1)                                'fetch cell contents from column A
        
        '----------------------------------------------
        Select Case zValue
        Case "SWISS", "heliocentric", "Delta", "page"       'test for unnecessary data in row
            Range(temp).ClearContents                       'clear data
                
        Case "Day"
            Range("A" & r).Cut Destination:=Range("B" & r) 'shift data across
                        
        Case Else
            If zValue Like "D:\*" Then
            Range(temp).ClearContents                       'clear data
            Else                                            'otherwise..
            
                If Trim(Range("B" & r)) = "Sid.t" Then
                Range("B" & r & ":M" & r).Cut Destination:=Range("E" & r)       'shift data across
                End If
                
                If Len(zValue) = 3 And UCase(zValue) <> "MAY" Then
                    Range("B" & r & ":O" & r).Cut Destination:=Range("C" & r)   'shift data across
                    Range("B" & r).Value = Trim(Right(zValue, 2))               'put last 2 chars from colA into colB
                    Range("A" & r).Value = Left(zValue, 1)                      'replace colA value with 1 char
                End If
                
                Range("B" & r).Value = Trim(Range("B" & r).Value)
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                For c = 6 To 15                                                 'process columns..
                    If Len(Trim(Cells(r, c))) < 6 And Len(Trim(Cells(r, c))) > 2 And _
                        Not Trim(Cells(r, c)) = "Terra" Then
                        Cells(r, c).Value = Trim(Cells(r, c) & "'00")
                    Else
                        Cells(r, c).Value = Trim(Cells(r, c))
                    End If
                Next
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            End If
            
        End Select
        '----------------------------------------------
                    
    Application.CutCopyMode = False                         'Clear Clipboard after any Cut & Paste
        
    'Display progress in bottom Status Bar..
    Application.StatusBar = "Clean CVS Data Progress: " & r & " of " & zLastRow & ": " & Format(r / zLastRow, "0%")
        
    Next
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    
    Worksheets(zSheetName).Select                           'return to start sheet
    
    
    With Application                                        'use shortcut
        .StatusBar = False                                  'Clear Status Bar Progress Status
        .ScreenUpdating = True                              'turn ON Screen updating
        .Calculation = xlAutomatic                          'turn Calcs back ON
        .EnableEvents = True                                'turn event trapping back ON
    End With
        
    MsgBox ("DONE!")
    
        
    Exit Sub                                            'all done
    '---------------------------------------------------
    ErrorMessages:
    
    Button = vbExclamation
    Title = "Public Sub CleanCSVData()..."
    
    
    
        Msg = "Error #:  " & Str(Err.Number) & " was generated by " & Err.Source & vbCrLf & _
              "Error Line:  " & Erl & vbCrLf & _
              Err.Description
        Response = MsgBox(Msg, Button, Title)
    
    End Sub
    I have placed this code in a sample file attached (but no data of course!)

    zeddy
    Attached Files Attached Files

  10. #10
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Bogangar NSW Australia
    Posts
    154
    Thanks
    29
    Thanked 3 Times in 2 Posts
    Hi Zeddy,

    Many thanks for your code and the suggested refinements therein. It's given me some new techbiques to apply in future

    I've run your code against my data and your code runs in about 87 seconds, compared to mine that takes around 97 seconds.

    Interestingly, with both your code and mine, the Status Bar "Clean CSV Data Progress..." stalls at around 6%, with Excel indicating it is "Not Responding" but the procedures continues running to completion.

    I've attached a copy of my data file if you wish to give it a run.

    Many thanks for your assistance.

    Cheers

    Kookaburra 02 (32x50).jpgBygAuldByrd
    Attached Files Attached Files

  11. #11
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi BygAuldByrd

    Many thanks for the sample data. This really helps!
    This will make it much easier to investigate the 'stalling' statusbar issue.
    I am working on a few techniques with this data.

    One of the best ways I found of improving my own vba coding was to look at code created by others.
    There are so many ways of achieving a desired result!

    I will post an updated demo file showing my test results.
    My current best processing time so far is 11 seconds, but I'm hoping for better than that.

    zeddy

  12. #12
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    If you use an array and skip the statusbar, which slows things down, it should be much faster:

    Code:
    Public Sub CleanCSVDataArray()
    
        Dim iLastRow              As Long
        Dim sht                   As Worksheet
        Dim iRowCount             As Long
        Dim iColumnCount          As Long
        Dim vDataIn
        Dim lCol                  As Long
    
        Dim Msg, Button, Title, Response As String
    
        On Error GoTo ErrorMessages
    
        Button = vbExclamation
        Title = "Public Sub CleanCSVData()..."
    
        '   Turn OFF Screen updating
        Application.ScreenUpdating = False
    
    
        '   **** Determine Last Row number
        Set sht = Worksheets("CSV Input Data")
        iLastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    
        vDataIn = sht.Range("A1:P" & iLastRow).Value2
        '   Check is Ephemeris is Heliocentric or Geocentric
        For iRowCount = 1 To 20
            If sht.Range("A" & iRowCount) = "heliocentric" Then
                Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Heliocentric"
                Exit For
            Else
                Sheets("Instructions & Summary").Range("ZodiacCentre").Value = "Geocentric"
            End If
        Next
    
    
        '   **** Start data cleanup process
    
    
        For iRowCount = 1 To iLastRow
    
    
            '   Test for unnecessary data in row
            Select Case vDataIn(iRowCount, 1)
                Case "SWISS", "heliocentric", "Delta", "page"
                    For lCol = LBound(vDataIn, 2) To UBound(vDataIn, 2)
                        vDataIn(iRowCount, lCol) = Empty
                    Next lCol
                Case Else
    
                    If Left(vDataIn(iRowCount, 1), 3) = "D:\" Then
                        For lCol = LBound(vDataIn, 2) To UBound(vDataIn, 2)
                            vDataIn(iRowCount, lCol) = Empty
                        Next lCol
                    Else
                        If Trim(vDataIn(iRowCount, 2)) = "Sid.t" Then
                            For lCol = 13 To 2 Step -1
                                vDataIn(iRowCount, lCol + 3) = vDataIn(iRowCount, lCol)
                                vDataIn(iRowCount, lCol) = Empty
                            Next lCol
                            vDataIn(iRowCount, 2) = vDataIn(iRowCount, 1)
                            vDataIn(iRowCount, 1) = Empty
    
                        ElseIf Len(vDataIn(iRowCount, 1)) = 3 And UCase(vDataIn(iRowCount, 1)) <> "MAY" Then
                            For lCol = 15 To 2 Step -1
                                vDataIn(iRowCount, lCol + 1) = vDataIn(iRowCount, lCol)
                            Next lCol
                            vDataIn(iRowCount, 2) = Trim(Right(vDataIn(iRowCount, 1), 2))
                            vDataIn(iRowCount, 1) = Left(vDataIn(iRowCount, 1), 1)
                        End If
                        vDataIn(iRowCount, 2) = Trim(vDataIn(iRowCount, 2))
                        For iColumnCount = 6 To 15
                            If Len(Trim(vDataIn(iRowCount, iColumnCount))) < 6 And Len(Trim(vDataIn(iRowCount, iColumnCount))) >= 3 And _
                               Not Trim(vDataIn(iRowCount, iColumnCount)) = "Terra" Then
                                vDataIn(iRowCount, iColumnCount) = Trim(vDataIn(iRowCount, iColumnCount) & "'00")
                            Else
                                vDataIn(iRowCount, iColumnCount) = Trim(vDataIn(iRowCount, iColumnCount))
                            End If
                        Next
                    End If
            End Select
    
    
    
    
            '   Clear Clipboard after Cut & Paste
            Application.CutCopyMode = False
    
            '   Display Processing progress in Status Bar
    '        Application.StatusBar = "Clean CVS Data Progress: " & iRowCount & " of " & iLastRow & ": " & Format(iRowCount / iLastRow, "0%")
    
        Next
    
        sht.Range("A1:P" & iLastRow).Value2 = vDataIn
    
        '   Clear Status Bar Progress Status
        Application.StatusBar = False
    
    
        '   Turn ON screen updating
        Application.ScreenUpdating = True
    
        Exit Sub
    
    
    ErrorMessages:
    
    
        Msg = "Error #:  " & Str(Err.Number) & " was generated by " & Err.Source & vbCrLf & _
              "Error Line:  " & Erl & vbCrLf & _
              Err.Description
        Response = MsgBox(Msg, Button, Title)
    
    
    End Sub
    Last edited by rory; 2016-04-21 at 11:22.
    Regards,
    Rory

    Microsoft MVP - Excel

  13. The Following User Says Thank You to rory For This Useful Post:

    zeddy (2016-04-21)

  14. #13
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi rory

    ..your code took less than 1 sec to run on my laptop, using the sample data (8832 rows).
    Just goes to show how efficient it is to process data in arrays!!
    If something takes less than a second, not much point in looking for a faster method!

    zeddy

  15. #14
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Bogangar NSW Australia
    Posts
    154
    Thanks
    29
    Thanked 3 Times in 2 Posts
    Hi Rory,

    Your's is a truely brilliant bit of code It's so fast I can't even measure the time it takes!

    As always, I'm learning how to improve my coding by the help and guidance you and the others that post here give so freely.

    Now I have to work out how to use it elsewhere in my coding

    Cheers

    Kookaburra 02 (32x50).jpgBygAuldByrd

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •