Question

I currently have an array which I populate and paste in a sheet named “T1” using a macro. My current macro uses the rowcount function to determine the used rows and pastes the array from the next available row.

The problem I am having is that when I paste this array multiple times, the arrays need to be spaced by a row so that i can differentiate different submissions. This is what I have so far, and I was hoping someone could help me with this:

Sub CopyData()

     Dim Truearray() As String
     Dim cell As Excel.Range
     Dim RowCount1 As Integer
     Dim i As Integer
     Dim ii As Integer
     Dim col As Range
     Dim col2 As Range
     i = 0
     ii = 2

     RowCount1 = DHRSheet.UsedRange.Rows.Count
     Set col = DHRSheet.Range("I1:I" & RowCount1)

     For Each cell In col

         If cell.Value = "True" Then

             Dim ValueCell As Range
             Set ValueCell = Cells(cell.Row, 3)
             ReDim Preserve Truearray(i)
             Truearray(i) = ValueCell.Value

             Dim siblingCell As Range
             Set siblingCell = Cells(cell.Row, 2)
             Dim Siblingarray() As String

             ReDim Preserve Siblingarray(i)
             Siblingarray(i) = DHRSheet.Name & "$" & siblingCell.Value

             i = i + 1

         End If

     Next

     Dim RowCount2 As Integer

     RowCount2 = DataSheet.UsedRange.Rows.Count + 1

     For ii = 2 To UBound(Truearray)
         DataSheet.Cells(RowCount2 + ii, 2).Value = Truearray(ii)
     Next

     For ii = 2 To UBound(Siblingarray)
         DataSheet.Cells(RowCount2 + ii, 1).Value = Siblingarray(ii)
     Next

     DataSheet.Columns("A:B").AutoFit

     MsgBox ("Data entered has been successfully validated & logged")

 End Sub 

Answer 1

If you Offset two rows from the bottom cell, you will leave a blank row of separation. You should also consider filling the whole array as base 1 and writing it to DataSheet in one shot.

Sub CopyData2()

    Dim rCell As Range
    Dim aTrues() As Variant
    Dim rRng As Range
    Dim lCnt As Long

    'Define the range to search
    With DHRSheet
        Set rRng = .Range(.Cells(1, 9), .Cells(.Rows.Count, 9).End(xlUp))
    End With

    'resize array to hold all the 'trues'
    ReDim aTrues(1 To Application.WorksheetFunction.CountIf(rRng, "True"), 1 To 2)

    For Each rCell In rRng.Cells
        If rCell.Value = "True" Then
            lCnt = lCnt + 1
            'store the string from column 2
            aTrues(lCnt, 1) = DHRSheet.Name & "$" & rCell.Offset(0, -7).Value
            'store the value from column 3
            aTrues(lCnt, 2) = rCell.Offset(0, -6).Value
        End If
    Next rCell

    'offset 2 from the bottom row to leave a row of separation
    With DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp).Offset(2, 0)
        'write the stored information at one time
        .Resize(UBound(aTrues, 1), UBound(aTrues, 2)).Value = aTrues
    End With

End Sub