Macro Adjustment Needed To Stop Freeze

[JimmiOO]

Hi

I have this macro, kindly donated by excelxx, it was working good when i tested it on a couple of hundred rowns of data. I have now dropped the live data into the workbook list.xls and it just seems to be stopping now.

The live list.xls is about 30.000 rows. It looks in colums A & B, i am not sure if this is the cause but i have some 0s and blanks in them columns. It maybe there is just to much data.

Could someone please have a look and maybe suggest where its going wrong. I have highlighted (CODE STOPS HERE) where the code seems to stop

Thanks

Sub GetInfo()
    Dim wbSum As Workbook: Dim wsSum As Worksheet
    Dim wbList As Workbook: Dim wsList As Worksheet
    Dim wbSupp  As Workbook: Dim wsSupp As Worksheet
    Dim wsMaster As Worksheet
    ThisWorkbook.Worksheets(1).Range("A2").Activate
    
    Application.ScreenUpdating = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\Summary.xls"
    Set wbSum = ActiveWorkbook
    Set wsSum = ActiveSheet
    ActiveWindow.Visible = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\List.xls"
    Set wbList = ActiveWorkbook
    Set wsList = ActiveSheet
    ActiveWindow.Visible = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\Supplier.xls"
    Set wbSupp = ActiveWorkbook
    Set wsSupp = ActiveSheet
    ActiveWindow.Visible = False
    
    Set wsMaster = ThisWorkbook.Worksheets(1)
    t = 1: s = 1: v = wsMaster.UsedRange.Rows.Count + 1
    Do Until t > wsSum.UsedRange.Rows.Count
        S_NSL = wsSum.Cells(t, 15).Value
        S_EAN = wsSum.Cells(t, 16).Value
        Do Until s > wsList.UsedRange.Rows.Count
           L_NSL = wsList.Cells(s, 1).Value                    (CODE STOPS HERE)
           L_EAN = wsList.Cells(s, 2).Value
            If S_NSL = L_NSL And S_EAN = L_EAN Then
                wsMaster.Cells(v, 1).Value = wsList.Cells(s, 3).Value
                wsMaster.Cells(v, 2).Value = S_NSL
                wsMaster.Cells(v, 3).Value = wsSum.Cells(t, 17).Value
                wsMaster.Cells(v, 4).Value = wsList.Cells(s, 4).Value
                wsMaster.Cells(v, 5).Value = wsList.Cells(s, 5).Value
                wsMaster.Cells(v, 6).Value = wsSum.Cells(t, 18).Value
                wsMaster.Cells(v, 7).Value = wsList.Cells(s, 6).Value
                
                Do Until w > wsSupp.UsedRange.Rows.Count
                    If wsMaster.Cells(v, 7).Value = wsSupp.Cells(w, 1).Value Then
                        wsMaster.Cells(v, 8).Value = wsSupp.Cells(w, 2).Value
                        w = wsSupp.UsedRange.Rows.Count
                    End If
                    w = w + 1
                Loop
                s = wsList.UsedRange.Rows.Count
                v = v + 1
            Else
             
            End If
            s = s + 1
        Loop
        s = 1: w = 1
        t = t + 1
    Loop
    z = 3
    wsMaster.Activate
    Do Until z > ActiveSheet.UsedRange.Rows.Count
        For n = 1 To 8
            Cells(z, n).Borders.LineStyle = xlContinuous
            Cells(z, n).NumberFormat = "General"
            Cells(z, n).HorizontalAlignment = xlCenter
            Cells(z, n).VerticalAlignment = xlCenter
        Next n
        Cells(z, 4).NumberFormat = "£#,##0.00"
        Cells(z, 5).NumberFormat = "£#,##0.00"
        Cells(z, 3).HorizontalAlignment = xlLeft
        Cells(z, 6).HorizontalAlignment = xlLeft
        Cells(z, 8).HorizontalAlignment = xlLeft
        
        z = z + 1
    Loop
    wbSum.Close False
    wbList.Close False
    wbSupp.Close False
    Application.ScreenUpdating = True
    
End Sub

[Leith Ross]

Hello JimmiOO,

You need to better define "code stops here". Does the macro generate an error? If so what is the error number? Does the macro keep looping? Does Excel just freeze?

[royUK]

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

[JimmiOO]

Hi Leith I do not get an error and it looks like the macro is still running but it just seems to keep looping then freezes up, when i press the esc button the macro is stopped on the part i have highlighted. Sorry RoyUK i have changed the title i hope this is better.

[JimmiOO]

Is there anything i could possible put in this code that would resume on errors? I have had it running all night and still the same, it seems to be stopping in the same place.

[excelxx]

Hi JimmiOO

I'm not sure what is going wrong here, but please let me know how many entries are in the following files

List
Supplier
Summary

I think we may have to switch off the screenupdating so that we can see what's going on.

[JimmiOO]

Hi excelxx

In the List there is about 15000
Supplier there is 179
and Summary there is about 2000

I think it is the amount of data, when i cut the list down to 1000 it takes a while but does work,

[excelxx]

Hi JimmiOO

The way I had written the code before seems like it was ok for small amounts of data but not so efficient for large amounts of data. (The disadvantage of being self taught).

If have revised the code so for the amount of data you mentioned it runs in good time.

Sub GetInfo()
    Dim wbSum As Workbook: Dim wsSum As Worksheet
    Dim wbList As Workbook: Dim wsList As Worksheet
    Dim wbSupp  As Workbook: Dim wsSupp As Worksheet
    Dim wsMaster As Worksheet
    ThisWorkbook.Worksheets(1).Range("A3").Activate
    
    Application.ScreenUpdating = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\Summary.xls"
    Set wbSum = ActiveWorkbook
    Set wsSum = ActiveSheet
    ActiveWindow.Visible = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\List.xls"
    Set wbList = ActiveWorkbook
    Set wsList = ActiveSheet
    ActiveWindow.Visible = False
    
    Workbooks.Open "C:\Documents and Settings\New Project\INFO\Supplier.xls"
    Set wbSupp = ActiveWorkbook
    Set wsSupp = ActiveSheet
    ActiveWindow.Visible = False
    
'
    Dim ceN As Range: Dim ceE As Range: Dim ceS As Range
    
'
    Set wsMaster = ThisWorkbook.Worksheets(1)
    t = 1: s = 1: v = wsMaster.UsedRange.Rows.Count + 1
    Do Until t > wsSum.UsedRange.Rows.Count
        Application.StatusBar = "Working on record " & t & " of " & wsSum.UsedRange.Rows.Count
        S_NSL = wsSum.Cells(t, 2).Value
        S_EAN = wsSum.Cells(t, 3).Value
        
'
        Set ceN = wsList.Range("A1:A" & wsList.UsedRange.Rows.Count).Find(S_NSL)
        Set ceE = wsList.Range("B1:B" & wsList.UsedRange.Rows.Count).Find(S_EAN)
        If ceN Is Nothing Or ceE Is Nothing Then
        ElseIf ceN.Row = ceE.Row Then
            s = ceN.Row
            wsMaster.Cells(v, 1).Value = wsList.Cells(s, 3).Value
            wsMaster.Cells(v, 2).Value = S_NSL
            wsMaster.Cells(v, 3).Value = wsSum.Cells(t, 4).Value
            wsMaster.Cells(v, 4).Value = wsList.Cells(s, 4).Value
            wsMaster.Cells(v, 5).Value = wsList.Cells(s, 5).Value
            wsMaster.Cells(v, 6).Value = wsSum.Cells(t, 5).Value
            wsMaster.Cells(v, 7).Value = wsList.Cells(s, 6).Value
            
            Set ceS = wsSupp.Range("A1:A" & wsSupp.UsedRange.Rows.Count).Find(wsMaster.Cells(v, 7).Value)
            If ceS Is Nothing Then
            Else
                w = ceS.Row
                wsMaster.Cells(v, 8).Value = wsSupp.Cells(w, 2).Value
            End If
            v = v + 1
        End If
        t = t + 1
    Loop
    wbSum.Close False
    wbList.Close False
    wbSupp.Close False
    Application.StatusBar = False
    Application.ScreenUpdating = True
        
End Sub

Please let me know how you get on.

[broro183]

hi Jimmi00,

I'm having a go at changing the code from your original post so that it will process arrays "in memory" which should help to speed up even when compared against Excelxx's revised version.

To help me grasp exactly what is needed, can you please explain the intent of the loops in "plain English"?

Excelxx, don't let being self taught become a limitation - I am self taught too & it lets me choose the best way from all the offerings that can be found on the web - without getting wrapped up in one teacher's belief that their way is the best way

Rob

[romperstomper]

I am self taught too & it lets me choose the best way from all the offerings that can be found on the web - without getting wrapped up in one teacher's belief that their way is the best way

Same for me too.

[broro183]

hi all,

Blimey!
Excelxx, you & I are in good company
It's good to see you pop by RS, you might be able to straighten out my below "theoretical" code (untested), even before we get a sample to test it on...

Jimmi00,
I've put some possible code in the attached file*, but it needs to be tested for validity (eg how will it respond to empty cells - perhaps we need to include Cstr as a wrapper etcetc) & functionality (eg the size of the arrays may cause it to not write back to the sheet correctly or even just roll over & curl up its toes!) - I'm not sure without testing it.
Can you please zip (I'm on a slow connection) & upload a sample file (maybe with 100 rows of dummy data) for each of the Master, List, Sum & Supp files?
Also, on rereading Excelxx's revision, you may find that his/her use of ".Find" is sufficient for speeding up the code. Anyway, in case you want to have a go at the testing yourself, please see attached file for my untested version with the original code commented out alongside it...
*(I've attached it as a file because, with the comments in the code, it made my post too long to upload.)

RomperStomper,
If you don't mind opening a file, do you have any thoughts on how likely it is that my approach will work?
Could I be trying to hold too much "in memory"?
How would you size the "wsMaster..." arrays?
Is my use of Erase worthwhile/am I using it correctly?

Thanks
Rob

[romperstomper]

Rob,
Without testing, I suspect that the nested loops will seriously hamper performance. I'm also not sure why you are using so many arrays for each range rather than one for each?

[JimmiOO]

Thanks for all the help guys

excelxx as always you have came up with something that does exactly what i need for this project, thank you so much again.

Rob and Romperstomper thanks very much for the input, it is greatly appreciated, I am just about to post something else that yous may be able to help with. Basically it will be the same sort of thing as this project with a few differences.

Thanks again, Problem Solved.

[broro183]

Thanks Romperstomper,

Yes, I thought the same for the loops, but I was feeling too lazy to wrap my head around the code so I could unravel them properly. I thought I'd wait until the OP explains in plain English & then I may be able to make more informed comments - perhaps, even to move right away from a macro approach & replace it with formulae...

Wow, this is my learning for the day :-)
Before your question, I was completely ignorant that arrays with more than "1 dimension" could be written back to a worksheet!

I've had a go at modifying my suggested code & will now wait for the OP to provide some example files for testing.

Thanks
Rob

[broro183]

Ohhh, I see once the page refreshed after posting that I'm too slow!

Oh well, just out of curiosity, how long does excelxx's version take to run?

Feel free to pm me a link to your new thread.

Rob