Should this code be written differently? Takes way longer than sorting each sheet manually
Page 3 of 5 FirstFirst 12345 LastLast
Results 21 to 30 of 47

Thread: Should this code be written differently? Takes way longer than sorting each sheet manually

  1. #21
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    I'm not sure how to post table in here, but here is the initial and desired results. I wasn't using any headers. Probably easier for me with no headers.



    - initial latitude longitude would be in column A,B
    - result of all combinations in column C,D (spread over many sheets because of row amount limitation in excel
    - results of the distance in column E (over the many sheets)
    - need all sheets sorted(I assume) so that only the first (x) rows could be copied to a master sheet
    - sheet1 needs to be deleted at some point, probably after all combinations.... at least in the way I've been doing it, it does not contain the combinations..... only the initial data
    * So basically I would
    1- copy the latitude and longitude values into A,B
    2- set the amount of rows (Change in code) that I want to be copied from all sheets to the master result sheet. The amount of rows from each sheet would be the same, so I would only set one value in the code.....will usually be 20 or 30.
    3- Master list sorted low to high
    4- End result!
    You can probably tell by all the code above what is going on

    I can't thank you enough for taking interest in this

    I will be in and out due to death in family, but will check back as often as I can

    David
    Last edited by strat919; Jul 22nd, 2019 at 08:22 AM.

  2. #22
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    I forgot to mention the the merge was only used because of the next macro. I assume the merge is not needed.

    Also, I guess sorting would not be necessary after unique pairs if I could set the code to copy the lowest values over all sheets to be copied to master. I could set, say 500 results to master over all the sheets. That may make it a lot quicker not having to sort all sheets.
    Last edited by strat919; Jul 22nd, 2019 at 08:46 AM.

  3. #23
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    I guess you could say it picks x amount of lowest values out of all the sheets...not per sheet... and places them in master sheet. In the master result sheet it would have A,B,C,D,E like in all the other sheets. If you don't think this would save much time or memory, then the sorting all sheets method would be better for me.

  4. #24
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,671
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    Your first code executes all macros.
    If that is how the code is going to be run, why not combine the macros so that the "For each WS in Worksheets" isn't run multiple times.
    Your various codes at the moment, loop through all the sheets, then the next code does the same sheet loop process, etc, etc.
    It could nearly all be done in one series of loops ???
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  5. #25
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    Hey Michael.......
    I know very little about any of this, but when I look at it and I could be totally wrong here.

    -
    Sub Text2Columns() all sheets need to be delimited
    -
    Sub deleteSheetByName() Just one sheet is deleted
    -
    Sub FindDistance()
    all sheets need distance
    -
    Sub SortAllSheets()
    all sheets need to be sorted for next macro, unless I had code to pick (x) amount of the lowest long lat values from by distance values
    -
    Sub CopyXRows2Master()
    top (x) amount of rows I set in the macro.... from all sheets . Results in the master, but not sorted in the master(next macro)
    -
    Sub SortMasterSheetE()
    sort the master

    Maybe I'm looking at it totally wrong, but doesn't all sheets have to be accessed in those macros?

    Thanks
    Last edited by strat919; Jul 23rd, 2019 at 03:05 PM.

  6. #26
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,671
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    Well, as an example, why can't "sortAll Sheets" and "CopytoMaster" be combined like this.
    Note the sort is done before copy rows !
    The text2columns probably could be thrown into this code as well...but what it means is the code is going through the sheets once only, not over and over again

    Code:
    Sub CopyXRows2Master()
    Dim lr As Long, ws As Worksheet, ans As Long
    Sheets.Add(after:=Worksheets(Sheets.Count)).Name = "Master"
    lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
    ans = 30
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            With ws
            .Columns("A:E").Sort Key1:=ws.Range("E1"), Order1:=xlAscending
            .Rows("1:" & ans).Copy Sheets("Master").Range("A" & lr)
            lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
            End With
        End If
    Next ws
    End Sub
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  7. #27
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    Try this

    To start with worksheet looks like this
    Excel 2016 (Windows) 32 bit
    A
    B
    1
    17.695367
    -94.882509
    2
    22.604667
    -89.515209
    3
    20.978867
    -89.262209
    4
    19.682367
    -87.809709
    5
    19.957467
    -91.277409
    6
    20.025367
    -86.121809
    7
    21.344367
    -93.437609
    8
    26.171767
    -90.014609
    9
    27.427167
    -93.532009
    10
    20.042567
    -87.880009
    11
    24.227967
    -88.523609
    12
    24.139467
    -93.652109
    13
    25.026667
    -86.809209
    14
    19.714567
    -91.068309
    15
    27.213467
    -87.960409
    16
    24.800967
    -92.572709
    Sheet: Sheet1

    I asked for 10 values to be returned :

    Excel 2016 (Windows) 32 bit
    A
    B
    C
    D
    E
    1
    21.50117
    -91.1147
    21.49797
    -91.12
    0.406253
    2
    18.94137
    -87.4702
    18.94487
    -87.4756
    0.427896
    3
    19.01427
    -90.0209
    19.01157
    -90.0282
    0.512166
    4
    21.91217
    -93.2721
    21.92447
    -93.2732
    0.85295
    5
    20.12217
    -89.9606
    20.11197
    -89.9746
    1.149885
    6
    21.50377
    -93.494
    21.48577
    -93.4935
    1.244361
    7
    25.13587
    -86.2795
    25.13527
    -86.2994
    1.245712
    8
    20.11167
    -87.9784
    20.10727
    -87.9595
    1.263648
    9
    20.23217
    -85.3814
    20.22367
    -85.3998
    1.329925
    10
    27.59177
    -87.1582
    27.59537
    -87.1796
    1.334098
    11
    Sheet: Results 190724 10.18 pm


    Test on a COPY of your workbook!
    Place the code in a NEW standard module
    Code:
    'this goes at TOP of module ABOVE all  procedures
    
        Option Explicit
        Private List() As Variant, Pairs() As Double
        Const Limit As Long = 500000
        Private PairCount As Long, ResultsCount As Long, Results As Worksheet, Data As Worksheet
     
    'procedures 
    
    Sub Strat919()
    
        Dim t As Double:    t = Timer
        ResultsCount = InputBox("How many items to output ?", "User choice", 100)
        Call GeneratePairs
        Call GenerateResults
        MsgBox Round(Timer - t, 1) & " seconds"
    End Sub
    Code:
    Private Sub GeneratePairs()
        Dim a As Long, b As Long, r As Long
        Set Data = ActiveSheet
        List = Data.Range("A1", Data.Range("A" & Data.Rows.Count).End(xlUp)).Resize(, 2)
        PairCount = (UBound(List) ^ 2 - UBound(List)) / 2
        ReDim Pairs(1 To PairCount, 1 To 5)
    'place paired values in array and calculate distance
            For a = 1 To UBound(List)
                For b = 1 To UBound(List)
                    If b < a Then
                        r = r + 1
                        Pairs(r, 1) = List(a, 1)
                        Pairs(r, 2) = List(a, 2)
                        Pairs(r, 3) = List(b, 1)
                        Pairs(r, 4) = List(b, 2)
                        Pairs(r, 5) = GetDistance(Pairs(r, 1), Pairs(r, 2), Pairs(r, 3), Pairs(r, 4))
                    End If
                Next b
            Next a
    End Sub
    
    Private Function GetDistance(ByVal Lat1, ByVal Long1, ByVal Lat2, ByVal Long2)
        With WorksheetFunction
            GetDistance = 6371 * .Acos(Cos(.Radians(90 - Lat1)) * Cos(.Radians(90 - Lat2)) + Sin(.Radians(90 - Lat1)) * Sin(.Radians(90 - Lat2)) * Cos(.Radians(Long1 - Long2))) / 1.609
        End With
    End Function
    Code:
    Private Sub GenerateResults()
        Dim r2  As Long, r1 As Long, c As Long, LimitCount As Long, Remainder As Long
    'insert new worksheet
        Set Results = Sheets.Add(before:=Sheets(1))
        Results.Name = "Results " & Format(Now, "yymmdd h.mm am/pm")
    'how many times to move subsets of values?, how many items in last subset?
        LimitCount = WorksheetFunction.RoundDown(PairCount / Limit, 0)
        Remainder = PairCount Mod Limit
    'move each subset in sequence
        r1 = 1
        For c = 1 To LimitCount
            r2 = r2 + Limit
            Call MoveSubset(r1, r2)
            r1 = r1 + Limit
        Next c
        If Remainder > 0 Then
            r2 = r2 + Remainder
            Call MoveSubset(r1, r2)
        End If
    End Sub
    
    Private Sub MoveSubset(firstItem As Long, lastItem As Long)
        Application.ScreenUpdating = False
        Dim rTemp As Long, r As Long, c As Long, tempArr()
        ReDim tempArr(1 To lastItem - firstItem + 1, 1 To 5)
    'move to temp array
        For r = firstItem To lastItem
            rTemp = rTemp + 1
            For c = 1 To 5
                tempArr(rTemp, c) = Pairs(r, c)
            Next c
        Next r
    'write to worksheet, sort and clear rows not required
        Results.Cells(Results.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(tempArr), 5) = tempArr
        Results.Range("A:E").Sort Key1:=Results.Range("E1"), Order1:=xlAscending, Header:=xlNo
        Results.Range("A1").Offset(ResultsCount).Resize(Limit, 5).ClearContents
    End Sub
    VBA actions
    - the user is asked how many items to return (let's assume user wants 200 )
    - co-ordinates in columns A and B of active sheet are written to a 2 column array
    - possible pairings are determined, distances calculated and values written to a 5 column array
    - results are written to a new worksheet
    - a restricted no of items are written to the worksheet, sorted (ascending), and the first 200 rows retained
    - the restriction is the value of constant Limit
    - then next batch of items are witten to the sheet (now contains Limit + 200), sorted and the first 200 rows retained
    etc until all values dealt with

    Trapping errors etc
    - have not had time to be sophisticated
    - what could cause VBA problems with your data ( text instead of values, no values , values that break the formula etc)
    - can incorporate error checking later

    User Options
    - do you always want the shortest distances ?
    - what else is required ?

    Let me know how you get on

  8. #28
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    I forgot to say that I added a timer so that different values for Limit can be tested to measure impact on performance

  9. #29
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    I'm going to have to address you as Mr. Yongle from now on It works perfectly.

    I entered 4500 lat long entries and the time for entire process was 3.5 min. It was taking little over 5 min before with same data.

    I entered 12,500 entries and it took 24 minutes for results. Before, for some reason, it would crash when the number of entries were over about 8000.

    The most incredible thing is the memory usage. Even with 12,500 entries, it only used between 4 and 5 gigs of memory. Before with the 12,500 entries it was approaching 80 to 95% of my 32 gigs. Maybe that was the problem causing the crashes.

    One thing I don't understand... excel only uses 18% or less of my processor speed during calculations. I'm assume that is an excel problem. It never seems to to go over 18 to 20% for anything.

    I can't thank you enough for this Mr. Yongle! I hope it didn't take you too long for this. I owe ya buddy.

    Thank you SO MUCH!

    Thank you too Michael M and everybody else

    David

  10. #30
    Board Regular
    Join Date
    May 2019
    Posts
    54
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Should this code be written differently? Takes way longer than sorting each sheet manually

    Sorry..... I didn't answer your questions.

    - I will always need the shortest distance
    - Nothing else is required

    As far as the limit, here is how I plan to work. Just for your information.
    I will have a master list of lat long coordinates. During the week, users will input new lat long coordinates to my website. Each week I will add their coordinates to the master list and check with your code to make sure there are not any duplicates. So at that point, I have no duplicates on master list. Then the next week I do the same. So I will use a limit of maybe 20 because most of the time I probably will have no duplicates. This is experimental and is probably the first attempt at this, so I will just have to see how it goes. The coordinates will be world wide. I just have to be assured I do not have any 3D objects on top of each other. I want to be correct as possible even though it will require more work. I will let you know when I have it up and running if interested. I'm hoping in about a month and a half.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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