VBA Jagged Array to Range

905 views Asked by At

My macro goes through a range, looping by columns, finds where the numeric data starts in each column and stores the ranges in a jagged array (the "matrix" variant in the code).

After that, I would like to return the entire matrix to a range in another worksheet. If I try to assign "matrix(1)" to the range where I want it to be put, it works fine, but if I try to assign the entire "matrix" to a range, I get blank cells.

How could I return all of the values in "matrix" to a range at once, without using loops?

This is the source data, through which the code loops: enter image description here

I would like that all of the rows of "matrix" would be returned as this: enter image description here

Here is my code:

       Sub MyMatrix()

        Dim wb1 As Workbook
        Set wb1 = ActiveWorkbook

        Dim wsNSA As Worksheet
        Set wsNSA = wb1.Worksheets("NSA")

        Dim wsSA As Worksheet
        Set wsSA = wb1.Worksheets("SA")

        Dim col As Range

        Dim matrix() As Variant


        'LR is the Last row and LC is the last column with data
        LR = wsNSA.Cells(1, 1).End(xlDown).Row
        LC = wsNSA.Cells(LR, 1).End(xlToRight).Column

        'Loops through columns and finds the row where numeric data begins
        For Each col In wsNSA.Range(wsNSA.Cells(1, 2), wsNSA.Cells(LR, LC)).Columns
        wsNSA.Activate
        nsa = wsNSA.Range(wsNSA.Cells(1, col.Column), wsNSA.Cells(LR, col.Column))

        num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
        nsa = wsNSA.Range(wsNSA.Cells(num_linha, col.Column), wsNSA.Cells(LR, col.Column))

    'The range starts in the column B in the worksheet, so the matrix ubound is 'col.column -1
        ReDim Preserve matrix(1 To col.Column - 1)
         matrix(col.Column - 1) = nsa

        Next

        wsSA.Range(wsSA.Cells(3, 2), wsSA.Cells(LR, LC)) = matrix


        End Sub
2

There are 2 answers

0
YowE3K On

If you are you willing to forget the requirement that the output should not be written inside a loop, the following code would probably do what you are trying to do:

Sub MyMatrix()

    Dim wb1 As Workbook
    Set wb1 = ActiveWorkbook

    Dim wsNSA As Worksheet
    Set wsNSA = wb1.Worksheets("NSA")

    Dim wsSA As Worksheet
    Set wsSA = wb1.Worksheets("SA")

    Dim c As Long
    Dim LC As Long
    Dim LR As Long
    Dim num_linha As Long
    Dim nsa As Variant

    With wsNSA
        'LR is the Last row and LC is the last column with data
        '???? Is data1_linha declared anywhere and assigned a value? ????
        LR = .Cells(data1_linha, 1).End(xlDown).Row
        LC = .Cells(LR, 1).End(xlToRight).Column

        'Loops through columns and finds the row where numeric data begins
        For c = 2 To LC
            nsa = .Range(.Cells(1, c), .Cells(LR, c))
            num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
            wsSA.Cells(3, c).Resize(LR - num_linha + 1, 1).Value = .Range(.Cells(num_linha, c), .Cells(LR, c)).Value
        Next
    End With

End Sub
0
Slai On

You can just copy all and delete the blank cells after:

Sheet1.Range("A3").CurrentRegion.Copy Destination:= Sheet2.Range("A3")

Sheet2.Range("A3").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp