CODEWITHSUNDEEP
arraysvbaexcel
Some user
Some user

Reputation: 49

Looping through a column and copying values from cell into an array

So i am really new to excel and I am trying to copy some values in a cell into an array and later display the array in a column. So what I have is a list of first names in a column(A).Then I have a list of numbers next to the names in column(B). So what I am trying to do is loop through the numbers and if any of the numbers equals 4. copy the name corresponding to the number into my array. and later display that array lets say in column D. This is what I have so far. 

    Option Explicit

    Public Sub loopingTest()

    Dim FinalRow As Long '
    Dim i As Long 'varable that will loop through the column
    Dim maxN As Integer 'variable that will hold the maximum number
    Dim j As Long 'variable that will hold the index of the array
    Dim ArrayTest As Variant

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

   For i = 1 To FinalRow 'loop until the last row

      If Range("B" & i) = 4 Then 'if any of the values of column B matches 4 then
        ArrayTest(j) = Range("A" & i) 'copy the value corresponding to column A to the array
        j = j + 1 'increment array index

     End If 'end of endif

     Next i 'increment column

     'output array into column D
     For x = 1 to FinalRow
        Range("D" & x)  = ArrayTest(x)
      Next x

     End Sub

Would this be a correct way of doing this? Also if I would update column B to any numbers I would love column D to update automatically. Any help would be appreciated

Upvotes: 2

Views: 14188

Answers (2)

user2140173
user2140173

Reputation:

Use WorksheetFunction.Transpose(Array) method to print an array to spreadsheet. It's an efficient (and built-in) method widely used to print an array to a spreadsheet in one go.

Avoid comments like End if 'end of end if as anybody reading your code will know that already. More about the DRY principle.

The downside of VBA Arrays is that you always have to specify the size at the creation time. It's a long topic and there are alternative ways, avoiding arrays etc, but I am not going to discuss it here. A workaround is to start at 0 and then resize(increase) the array as you go using ReDim Preserve 

Public Sub loopingTest()

    Dim lastRow As Long
    Dim i As Long
    ReDim ArrayTest(0)

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

    For i = 1 To lastRow

        If Range("B" & i) = 4 Then 'if any of the values of column B matches 4 then

            ArrayTest(UBound(ArrayTest)) = Range("A" & i) 'copy the value corresponding to column A to the array
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)

        End If

    Next i

    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)

End Sub

now a short version of your code would be

Public Sub loopingTest()
    Dim i As Long: ReDim ArrayTest(0)
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Range("B" & i) = 4 Then
            ArrayTest(UBound(ArrayTest)) = Range("A" & i)
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)
        End If
    Next i
    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)
End Sub

Update:

You can use a variable instead of 4

Public Sub loopingTest()

    Dim lastRow As Long
    Dim myNumber as Long
    myNumber = 5
    Dim i As Long
    ReDim ArrayTest(0)

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

    For i = 1 To lastRow

        If Range("B" & i) = myNumber Then 

            ArrayTest(UBound(ArrayTest)) = Range("A" & i) 
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)

        End If

    Next i

    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)

End Sub

Upvotes: 3

JosieP
JosieP

Reputation: 3410

purely for information you could do the same without looping using something like

Public Sub nonloopingTest()

   Dim lastRow                     As Long
   Dim myNumber                    As Long
   Dim vOut

   myNumber = 5

   lastRow = Cells(Rows.Count, 1).End(xlUp).Row   ' will get the last row
   vOut = Filter(ActiveSheet.Evaluate("TRANSPOSE(if(B1:B" & lastRow & "=" & myNumber & ",A1:A" & lastRow & ",""||""))"), "||", False)
   If UBound(vOut) > -1 Then Range("D1").Resize(UBound(vOut) + 1) = WorksheetFunction.Transpose(vOut)

End Sub

Upvotes: 1

Related Questions