Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

I am trying to get familiar with arrays in VBA. I Want to copy lines that contain "1" in another sheet and place them at the end of the list and then delete then from the original sheet. Here is the code I put together. It does not work.

Can anybody help me please?

Sub array1()
Dim Oblast() As Variant
Dim dimension1 As Long
Dim i As Long
Dim dvojPole() As Variant

Worksheets("live_position").Activate

Oblast = Range("A2", Range("A1").End(xlDown))
dimension1 = UBound(Oblast, 1)
ReDim dvojPole(1 To dimension1, 1 To 2)

For i = 1 To dimension1
Set dest = Worksheets("closed").Range("A1").End(xlDown).Offset(1, 0)
    If dvojPole(i, 1) = 1 Then
        dvojPole(i, 1).EntireRow.Copy Destination:=dest
        dvojPole(i, 1).EntireRow.Delete
    End If

Next i
End Sub
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
248 views
Welcome To Ask or Share your Answers For Others

1 Answer

Consider the below example. You did not properly define your array and did not iterate across its values. The key here is to reference the cell value location and actual cell value in order to iterate across the range.

On Error GoTo ErrHandle:
    Dim Oblast() As Variant
    Dim xlcell As Range, cleanupRng As Range
    Dim i As Integer, j As Integer, k As Integer, l As Integer, counter As Integer

    ' DEFINE DIMENSION OF ARRAY
    ReDim Oblast(0 To Range("A2", Range("A1").End(xlDown)).Count)

    ' INSERT VALUES (CELL LOCATION) IN ARRAY
    i = 0
    For Each xlcell In Range("A2", Range("A1").End(xlDown))
        Oblast(i) = xlcell.Address(False, False, xlA1)
        i = i + 1
    Next xlcell

    j = Worksheets("closed").Range("A1").End(xlDown).Row + 1

    ' ITERATE ACROSS ARRAY
    For k = LBound(Oblast) To UBound(Oblast) - 1
        If Range(Oblast(k)) = 1 Then
            Range(Oblast(k)).Copy Destination:=Worksheets("closed").Range("A" & j)
            Range(Oblast(k)).EntireRow.ClearContents
        End If
    j = j + 1
    Next k

    ' DELETING CLEARED ROWS
    Set cleanupRng = Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)

    l = 1
    For counter = 1 To ActiveSheet.UsedRange.Rows.Count
        If Len(cleanupRng.Cells(l)) = 0 Then
            cleanupRng.Cells(l).EntireRow.Delete
        Else
            l = l + 1
        End If
    Next counter
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description
    Exit Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...