Write outcome of arrays into next available cell

Question

I am working on the code where I am converting the matrix table into 3 columns . Matrix table is on sheet1 and my transfer into columns is in sheet2.

I am using 4 arrays to convert the matrix. 1 array for ids, 2nd array for dates in a horizontal column, the 2nd array for dates in a vertical array and 3rd array for values in the matrix that match vertical and horizontal dates. I want to write into sheet2 array of ids, arrays of horizontal dates and array of values from matrix based on the match with vertical dates.

My code works fine, except for the fact that I would like to write the result of the arrays in sheet2 as into next available cells (not on the same level as arrays read).

This is the result written in sheet2 once the code is run and finds values in matrix based the on the match between vertical and horizontal dates:

What should I add to my code so that results of arrays written to sheet2 are written into next available cell?

Sub Test()
  Dim i As Integer, d As Integer, IntLastRow As Integer, IntLastCol As Integer
  Dim w1 As Worksheet, w2 As Worksheet

  Set w1 = Worksheets("Sheet1")
  Set w2 = Worksheets("Sheet2")
  IntLastRow = w1.Cells(Rows.Count, 1).End(xlUp).Row
  IntLastCol = w1.Cells(2, Columns.Count).End(xlToLeft).Column

  Dim Ary_ids() As Variant
  Dim Ary_Months_Vertic() As Variant 'dates to match horiz dates (no output)
  Dim Ary_Months_Horizont() As Variant 'dates to write to sheet2
  Dim Ary_Values() As Variant

  With w1
    ReDim Ary_ids(IntLastRow, 1)
    ReDim Ary_Months_Vertic(IntLastRow, 2)
    ReDim Ary_Months_Horizont(2, IntLastCol)
    ReDim Ary_Values(IntLastRow, IntLastCol)

    For i = 1 To UBound(Ary_ids, 1)
      For d = 1 To UBound(Ary_Months_Horizont, 2)
        Ary_ids(i, 1) = .Cells(i + 2, 1)             'Array ids
        Ary_Months_Vertic(i, 2) = .Cells(i + 2, 2)   'Array dates/rows
        Ary_Months_Horizont(2, d) = .Cells(2, d + 2) 'Array dates/cols
        Ary_Values(i, d) = .Cells(i + 2, d + 2)      'Array values

        If Ary_Values(i, d) <> 0 Then   'If values of matirx are non-zero
          If Ary_Months_Horizont(2, d) = Ary_Months_Vertic(i, 2) Then 'horiz=vert
            If Ary_Months_Horizont(2, d) <> "" Then 'If horiz dts <> emptystring
              w2.Cells(i + 1, 1) = Ary_ids(i, 1) 'labels only for these dates
              w2.Cells(d + 1, 2) = Ary_Months_Horizont(2, d) 'not-nothing months
              w2.Cells(i + 1, 3) = Ary_Values(i, d) 'Write amounts respectively
            End If
          End If
        End If
      Next d
    Next i
  End With
End Sub

user_7657180 · Answer

In fact the code is horrible ..Generally to satisfy your needs put these two lines before setting up the worksheets

Dim r As Long
r = 1

Then after this line and inside the loop

If Ary_Months_Horizont(2, d) <> "" Then

Put the line to increment the variable 'r'

r = r + 1

Now you can use this variable with the following lines

w2.Cells(r, 1) = Ary_ids(i, 1)
w2.Cells(r, 2) = Ary_Months_Horizont(2, d)
w2.Cells(r, 3) = Ary_Values(i, d)

UPDATE: You can try this code instead

Sub Test()
Dim ws As Worksheet, sh As Worksheet, r As Long, m As Long, x

Set ws = ThisWorkbook.Worksheets("Sheet1")
Set sh = ThisWorkbook.Worksheets("Sheet2")

sh.Range("A1").Resize(1, 3).Value = Array("Name", "Date", "Value")
m = 1

For r = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    x = Application.Match(ws.Cells(r, 2), ws.Range(ws.Cells(2, 3), ws.Cells(2, ws.Cells(2, Columns.Count).End(xlToLeft).Column)), False)
    If Not IsError(x) Then
        If ws.Cells(r, x + 2).Value <> "" Then
            m = m + 1
            sh.Cells(m, 1).Resize(1, 2).Value = ws.Cells(r, 1).Resize(1, 2).Value
            sh.Cells(m, 3).Value = ws.Cells(r, x + 2).Value
        End If
    End If
Next r
End Sub

Write outcome of arrays into next available cell

1 Answers