VBA moving rows through arrays

Question

I am pretty new with arrays in VBA, and need some help finishing a code...

The objective is to copy from one array to another if a value in the first part of the array is found. Here's what I have so far, and I have put comments in the lines that I am struggling with.

Option Explicit

Sub ReadingRange()

Dim ARRAY_Multiwage As Variant
Dim ARRAY_TEMP_Multiwage() As Variant
ARRAY_Multiwage = Sheets("Multiwage").Range("A1").CurrentRegion

Dim a As Long
Dim b As Long
For a = LBound(ARRAY_Multiwage, 1) To UBound(ARRAY_Multiwage, 1)
    If ARRAY_Multiwage(a, 1) = "60021184_2018/36/HE" Then
        'add ARRAY_Multiwage(a, 1) to ARRAY_TEMP_Multiwage
        'Debug print to see that it has been added
    Else:
    End If
 Next a
End Sub

Any help would be greatly appreciated

zedfoxus · Accepted Answer · 2020-06-11 01:19:12Z

1

Try this out. What you are looking for is ReDim option to dynamically expand an array before entering data into the newest slot.

Sub ReadingRange()

    Dim ARRAY_Multiwage As Variant
    Dim ARRAY_TEMP_Multiwage() As String
    ARRAY_Multiwage = Sheets("Sheet2").Range("A1").CurrentRegion

    Dim a As Long
    Dim b As Long

    ' c is the counter that helps array become larger dynamically
    Dim c As Long
    c = 0

    For a = LBound(ARRAY_Multiwage, 1) To UBound(ARRAY_Multiwage, 1)

        If ARRAY_Multiwage(a, 1) = "60021184_2018/36/HE" Then

            ' change the dimension of the array
            ReDim Preserve ARRAY_TEMP_Multiwage(c)
            ' add data to it
            ARRAY_TEMP_Multiwage(c) = ARRAY_Multiwage(a, 1)
            ' print what was added
            Debug.Print ("Ubound is " & UBound(ARRAY_TEMP_Multiwage) & ". Latest item in array is " & ARRAY_TEMP_Multiwage(UBound(ARRAY_TEMP_Multiwage)))
            ' get ready to expand the array
            c = c + 1

        Else:
        End If

     Next a
End Sub

answered Jun 11, 2020 at 1:19

zedfoxus

37.4k5 gold badges68 silver badges66 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

FrostE1 Over a year ago

Hi zedfoxus, I have replied, but to show the updated code, i had to "post an answer", hope that was the right way to interact....

zedfoxus Over a year ago

Yeah, that is fine. Not a problem. If this answer has helped you, consider marking that as accepted. I think you should do that for all the other questions you have asked for which you have received helpful answer. Hope this helped.

Samuel Everson · Accepted Answer · 2020-06-11 01:21:47Z

I tend to use a Long data type variable as a counter within the loop for the destination array, that way each time the array is accessed, a new element can be written to. In past I've been steered towards declaring the new array with the maximum upper bound it could hold and resize it once at the end so the below example will follow that.

Option Explicit

Sub ReadingRange()

Dim ARRAY_Multiwage As Variant
Dim ARRAY_TEMP_Multiwage() As Variant
ARRAY_Multiwage = Sheets("Multiwage").Range("A1").CurrentRegion

Dim a As Long
Dim b As Long
Dim ArrayCounter as Long
ArrayCounter = 1 'Or 0, depends on if you are using a zero based array or not

For a = LBound(ARRAY_Multiwage, 1) To UBound(ARRAY_Multiwage, 1)
    If ARRAY_Multiwage(a, 1) = "60021184_2018/36/HE" Then
        ARRAY_TEMP_Multiwage(ArrayCounter) = ARRAY_Multiwage(a, 1)
        Debug.Print ARRAY_TEMP_Multiwage(ArrayCounter)
        ArrayCounter = ArrayCounter + 1
    Else
        'Do nothing
    End If
 Next a

ReDim Preserve ARRAY_TEMP_Multiwage (1 To (ArrayCounter - 1))
End Sub

VBasic2008 · Accepted Answer · 2020-06-11 03:03:32Z

Copy Range With Criteria

The following will copy from worksheet Sourceultiwage to worksheet Targetultiwage both in ThisWorkbook, the workbook containing this code.
Adjust the values in the constants section including wb.
Additionally you can choose to copy headers (copyHeaders)

The Code

Option Explicit

Sub copyWithCriteria()

    ' Source
    Const srcName As String = "Sourceultiwage"
    Const srcFirst As String = "A1"
    ' Target
    Const tgtName As String = "Targetultiwage"
    Const tgtFirst As String = "A1"
    ' Criteria
    Const CriteriaColumn As Long = 1
    Const Criteria As String = "60021184_2018/36/HE"
    ' Headers
    Const copyHeaders As Boolean = False
    ' Workboook
    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Write values from Source Range to Source Array.
    Dim rng As Range
    Set rng = wb.Worksheets(srcName).Range(srcFirst).CurrentRegion
    Dim NoR As Long
    NoR = WorksheetFunction.CountIf(rng.Columns(CriteriaColumn), Criteria)
    Dim Source As Variant: Source = rng.Value

    ' Write values from Headers Range to Headers Array.
    If copyHeaders Then
        Dim Headers As Variant: Headers = rng.Rows(1).Value
    End If

    ' Write from Source to Target Array.
    Set rng = Nothing
    Dim UB1 As Long: UB1 = UBound(Source)
    Dim UB2 As Long: UB2 = UBound(Source, 2)
    Dim Target As Variant: ReDim Target(1 To NoR, 1 To UB2)
    Dim i As Long, j As Long, k As Long
    For i = 1 To UB1
        If Source(i, CriteriaColumn) = Criteria Then
            k = k + 1
            For j = 1 To UB2
                Target(k, j) = Source(i, j)
            Next j
        End If
    Next i

    ' Write from Target Array to Target Range.
    With wb.Worksheets(tgtName).Range(tgtFirst)
        If copyHeaders Then .Resize(, UB2).Value = Headers          ' Headers
        .Offset(Abs(copyHeaders)).Resize(NoR, UB2).Value = Target   ' Data
    End With

    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"

End Sub

Collectives™ on Stack Overflow

VBA moving rows through arrays

3 Answers 3

2 Comments

Comments

Copy Range With Criteria

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

Comments

Copy Range With Criteria

Comments

Your Answer

Sign up or log in

Post as a guest

Related