CODEWITHSUNDEEP
arraysvbaexcelmacros
user3055019
user3055019

Reputation: 17

Excel VBA - insert rows from range to array based on criteria; then populate certain ranges on another sheet with data from array

My VBA knowledge is very limited. I looked through the questions on StackOverflow and googled for a couple of days, but I couldn't find the solution to my problem.

So, I am working on an Excel macro. I have a range A3:H7136. Certain cells in column A have a value of 1; the rest are blank. Cells in columns D, E, F, G, H may be blank or may contain text or numbers.

What I am trying to do is take the range A3:H7136 and put the data into an array; exclude rows with blank A cells AND with blank D cells; convert to a "final" array, from where the data from columns 2, 4 and 8 will be pasted into ranges D309:D558, G309:G558, J309:J558 on another worksheet.

So far I've got the following: 

Private Sub CommandButton1_Click()
Dim RowArray() As Long
Dim my_array1 As Range
Dim my_array2 As Variant
Dim i As Integer

Set my_array1 = ThisWorkbook.Worksheets("ETC").Range("A3:H7136")
my_array2 = my_array1.Value

For i = 1 To UBound(my_array2)
    If my_array2(i, 1) = 1 And my_array2(i, 4) <> "" Then
        RowArray(x) = i: x = x + 1
    End If
Next i

Sheets("Allocation").Range("D309:D558") = Application.Index(my_array2, 1, Array(4))
Sheets("Allocation").Range("J309:J558") = Application.Index(my_array2, 1, Array(2))
End Sub

I stopped there because I realized that the code pastes #value! into the ranges on another worksheet. This code is "Frankenstein-ed" from several forums so it might look very weird to a professional. I need help getting the code to work. I also have several questions:

  1. If the "final" array is 100% blank (which can happen), how do I get rid of #Value! on another worksheet?
  2. In the last two rows it looks to me like I am using the original my-array2, and not the "final" filtered version of it. Should I declare the "final" array?
  3. My paste range is only 250 rows; there is no way the number of non-blank rows in the array will ever exceed 250 rows, however, will that difference be a problem?

Thanks in advance!

Upvotes: 0

Views: 3004

Answers (1)

Scott Craner
Scott Craner

Reputation: 152585

A couple things:

RowArray's size was never declared so it would throw an out of bounds error.

You can use three array for the outputs in the loop then directly assign the arrays to the needed areas.

Private Sub CommandButton1_Click()
Dim DArray() As Variant
Dim GArray() As Variant
Dim JArray() As Variant

Dim my_array2 As Variant
Dim i As Long, x As Long
Dim cnt As Long

cnt = ThisWorkbook.Worksheets("ETC").Evaluate("COUNTIFS(A3:A7136,1,D3:D7136,""<>"")")
If cnt > 0 Then
    ReDim DArray(1 To cnt, 1 To 1) As Variant
    ReDim GArray(1 To cnt, 1 To 1) As Variant
    ReDim JArray(1 To cnt, 1 To 1) As Variant

    my_array2 = ThisWorkbook.Worksheets("ETC").Range("A3:H7136").Value
    x = 1
    For i = 1 To UBound(my_array2)
        If my_array2(i, 1) = 1 And my_array2(i, 4) <> "" Then
            DArray(x, 1) = my_array2(i, 4)
            GArray(x, 1) = my_array2(i, 4)
            JArray(x, 1) = my_array2(i, 8)
            x = x + 1
        End If
    Next i

    Sheets("Allocation").Range("D309").Resize(UBound(DArray, 1), 1).Value = DArray
    Sheets("Allocation").Range("G309").Resize(UBound(GArray, 1), 1).Value = GArray
    Sheets("Allocation").Range("J309").Resize(UBound(JArray, 1), 1).Value = JArray
End If
End Sub

Upvotes: 1

Related Questions