2
\$\begingroup\$

My code parses through a contiguous range of data in a spreadsheet (orng) and creates subranges from orng that contain the same string value (lot number) in the 6th column of orng. orng has 42 rows and 38 columns and each subrange has 1-15 rows and 38 columns.

As far as I know, I can't create a new range object for each subrange since the number of subranges is unknown. I've created an array that contains the data for the subranges (aData). I

have gotten it to work with the code below, but I feel like there is a much cleaner way of doing it that I can't figure out. I've also tried using a dictionary with no success. I will eventually have to call upon all the data for calculations and using multiple nested for loops to access each element seems convoluted.

I would prefer that the array was dynamic, but whenever I attempted the ReDim Preserve method the values would not be saved to the array. The size of the array would be correct, but every element was "Empty". According to Microsoft "each element of an array must have its value assigned individually" so it seems as though the only way I can keep the values when creating the array is to assign to each element.

After I found that webpage I implemented an array with a predetermined structure and the nested for loops. Is it possible to add the entire subrange to the array in one go? If not, what about a row?

Ideally, I could separate orng into different Areas, but since it is contiguous I am unable to do so (I'm not aware of a way to create Areas in a contiguous range).

What I'd like to know are:

  1. is there a better way to do what I am trying to do (collection, dictionary, etc.)

  2. if there is not a better way, can I get some advice on how to make this code cleaner (Easier to read, faster, less code, dynamic range, better structure)?

    Private Sub rangetest()

    Dim twb As Workbook: Set twb = ThisWorkbook
    Dim cws As Worksheet: Set cws = twb.Sheets("Cleaned_2019+")
    Dim orng As Range
    Dim datelot As String, datelotcomp As String
    Dim c As Long, i As Long, j As Long, k As Long, numrows As Long, lastrow 
        As Long, numlots As Long, _
        curRow As Long, lotRows As Long, startRow As Long, layerRows As Long, 
        aRow As Long
    Dim aLot() As Variant, aData(9, 49, 37) As Variant
    Dim Z As Boolean

    Set orng = cws.Range("A973:AL1014")   'Set initial range to work with.
    numrows = orng.Rows.Count             'Number of rows in orng.
    curRow = 1                            'Current row in orng.
    startRow = 1                          'Starting row in orng for next 
    layer (changes when lot changes).
    i = 0                                 'Layer of array (for aLot and aData arrays).
    j = 0                                 'Row in orng where values for previous layer ended.
    Z = False
    Do Until Z = True
        datelot = Left(orng.Cells(curRow, 6).Value, 10)                            'Lot that we want the data for. Corresponds to a layer in the aData array.
        datelotcomp = Left(orng.Cells(curRow + 1, 6).Value, 10)                    'Lot of the next row in data sheet.
        If datelot <> datelotcomp Then                                             'If datelotcomp <> to datelot then we want a new layer for array.
            layerRows = curRow - j                                                 'Number of rows for a particular layer
            ReDim Preserve aLot(i)                                                 'Array of lot names
            aLot(i) = datelot                                                      'Assign lot name to aLot array
            For aRow = 1 To layerRows                                              'Row index in array
                For lotRows = startRow To curRow                                   'Loops through orng rows and sets those values in array
                    For c = 1 To 38                                                'Loops through columns. There are always 38 columns
                        aData(i, aRow - 1, c - 1) = orng.Cells(lotRows, c).Value   'Add values to each index in array
                    Next c
                Next lotRows
            Next aRow
            j = curRow
            i = i + 1
            startRow = curRow + 1
        End If
        If curRow = numrows Then                                                   'End loop at end of orng
            Z = True
        End If
        curRow = curRow + 1
    Loop
    numlots = i

    End Sub

The result I get is an array with the structure aData(9, 49, 37) that contains data in the first 4 layers aData(1-3, , ). This corresponds with the unique number of lots (criteria from column 6 of orng) so the code is working correctly. I'd just like advice on if I'm doing anything inefficiently.

I will be checking back to answer questions or to add clarification.

Edit 1:

The orng size will change based on user input. I have the user inputting a start and end date and orng is created based on those values. Once I have the subranges from orng I will then use other criteria from other columns of the subrange to determine which rows to apply calculations to. The end result will be the lot number(s) with the calculations for the lot(s) printed out for the user.

\$\endgroup\$

closed as off-topic by πάντα ῥεῖ, 23fc9a62-56de-47fb-97b4-737890, pacmaninbw, Billal Begueradj, Donald.McLean Jul 12 at 14:50

This question appears to be off-topic. The users who voted to close gave this specific reason:

  • "Code not implemented or not working as intended: Code Review is a community where programmers peer-review your working code to address issues such as security, maintainability, performance, and scalability. We require that the code be working correctly, to the best of the author's knowledge, before proceeding with a review." – πάντα ῥεῖ, 23fc9a62-56de-47fb-97b4-737890, pacmaninbw, Billal Begueradj, Donald.McLean
If this question can be reworded to fit the rules in the help center, please edit the question.

  • \$\begingroup\$ Ever thought of using a pivot table to do this work for you? \$\endgroup\$ – AJD Jul 10 at 22:17
  • \$\begingroup\$ Yes, there is a better way, and yes you can make the code cleaner. Are you able to post up some sample data and expected output as well? \$\endgroup\$ – AJD Jul 10 at 22:19
  • \$\begingroup\$ A pivot table will not work with what I am going to be doing with the ranges for the end result. Do I just post a picture of the data? I tried adding the data to the original post, but the formatting was a mess. Thank you for your response! \$\endgroup\$ – lifeuhfindsaway Jul 11 at 15:09
  • \$\begingroup\$ If the image is readable on this site, then posting an image should suffice. \$\endgroup\$ – AJD Jul 11 at 22:52
3
\$\begingroup\$

There is not much to review as far as the code goes other than avoid using 3D arrays. The problem with 3D arrays is that you need to know the exact size of the first 3 dimensions because only the last dimension is resizable

I attempted the ReDim Preserve method the values would not be saved to the array.

You may want to post your attempts to use ReDim Preserve on StackOverflow because ReDim Preserve does save the values in the array.

Ideally, I could separate orng into different Areas, but since it is contiguous I am unable to do so (I'm not aware of a way to create Areas in a contiguous range). What I'd like to know is 1) is there a better way to do what I am trying to do (collection, dictionary, etc.) and 2) if there is not a better way, can I get some advice on how to make this code cleaner (Easier to read, faster, less code, dynamic range, better structure)?

It is hard to give advice without knowing what you are trying to do with the data other than group it. What I can do is show you how to store non-contiguous ranges in a Dictionary by Lot number and then work with the ranges afterwards.

Private Sub Dictionarytest()
    Dim map As New Scripting.Dictionary, rw As Range
    Dim key As Variant
    'Join Ranges Based on Lot Number and Add them to the Dictionary Map

    With ThisWorkbook.Sheets("Cleaned_2019+")
        For Each rw In .Range("A973:AL1014").Rows
            key = rw.Columns(6).Value

            If map.Exists(key) Then
                Set map(key) = Union(map(key), rw)
            Else
                map.Add key, rw
            End If
        Next
    End With

    Dim subRange As Range

    'Iterate of the Dictionary Map Keys and Print the Join Ranges Addresses
    For Each key In map
        Set subRange = map(key)
        Debug.Print subRange.Address(False, False)
    Next

    Dim item As Variant
    'Iterate of the Dictionary Map Items and Print the Join Ranges Addresses
    For Each item In map.Items()
        Debug.Print item.Address(False, False)
    Next

    Dim Data As Variant
    'Create an Array From the Dictionary Items
    Data = map.Items()
    'Iterate of the Data Array and Print the Join Ranges Addresses
    For Each item In Data
        Debug.Print item.Address(False, False)
    Next

    Dim results As Variant
    Dim r As Long, c As Long, rowCount As Long
    'Iterate of the Dictionary Map Keys and Create Array From the Join Ranges Addresses
    'Note: the Results Array Contains all the Data for a Single Lot Number
    For Each key In map
        Set subRange = map(key)
        rowCount = subRange.Cells.CountLarge / subRange.Columns.Count
        ReDim results(1 To rowCount, 1 To subRange.Columns.Count)
        r = 0
        For Each rw In subRange.Rows
            r = r + 1
            For c = 1 To UBound(results, 2)
                results(r, c) = rw.Columns(c).Value
            Next
        Next
    Next

End Sub

Immediate Window Print Out

A973:AL973,A975:AL975,A979:AL979,A985:AL985,A989:AL989,A1006:AL1006 A974:AL974,A982:AL982,A991:AL991,A1002:AL1002,A1013:AL1013 A976:AL976,A1007:AL1007 A977:AL977,A981:AL981,A1001:AL1001 A978:AL978,A988:AL988,A994:AL994,A996:AL996,A1014:AL1014 A980:AL980,A984:AL984,A990:AL990,A998:AL998,A1004:AL1004,A1009:AL1009 A983:AL983,A986:AL986,A993:AL993,A997:AL997,A999:AL999,A1003:AL1003 A987:AL987,A992:AL992,A995:AL995 A1000:AL1000,A1005:AL1005,A1008:AL1008,A1010:AL1011 A1012:AL1012

\$\endgroup\$
  • \$\begingroup\$ as usual (from you) Brilliant use of union with dictionary. I am only started thinking about avoiding use of 3D array. Forcing me to be hardened fan of your code. \$\endgroup\$ – Ahmed AU Jul 11 at 1:43
  • \$\begingroup\$ @AhmedAU thank you sir! \$\endgroup\$ – TinMan Jul 11 at 12:41
  • \$\begingroup\$ I will work on implementing this today and get back to you with the results. This definitely looks more like what I was trying to do, but lacked the know-how. Thank you! \$\endgroup\$ – lifeuhfindsaway Jul 11 at 15:13
  • \$\begingroup\$ This was the core code I ended up using. I had to add some qualifiers, but it worked as intended in the end. Thank you very much. \$\endgroup\$ – lifeuhfindsaway Jul 16 at 22:50
  • \$\begingroup\$ @lifeuhfindsaway I'm glad that it helped. Thanks for accepting my answer. \$\endgroup\$ – TinMan Jul 17 at 8:58

Not the answer you're looking for? Browse other questions tagged or ask your own question.