Array Loop that adds more and more data for each loop

Question

Got this VBA:

Sub HenteDataFraSkjema1()

Dim wbThis                  As Workbook
Dim wbTarget                As Workbook
Dim sht1 As Worksheet
Dim Data() As Variant
Dim i As Integer
    
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Ark1")
Folder = "H:\Mine dokumenter\Nedlastinger\Rapporter\"
Fname = Dir(Folder)

Do While Fname <> ""

  Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
  Set wsData = ThisWorkbook.Sheets("Ark1")
  
    Dim DataEntry As Range
    Set DataEntry = wbTarget.Sheets(1).Range("B3,G3,B7,R7")

            If Len(DataEntry.Cells(1, 1).Value) > 0 Then
                For Each Item In DataEntry
                    i = i + 1
                    ReDim Preserve Data(1 To i)
                    Data(i) = Item.Value
                Next
        
        wsData.Cells(wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row + 1, 1).Resize(1, i).Value = Data
            
            End If
 
Fname = Dir

wbTarget.Close True
        
Loop

End Sub

I'm trying to scan through all files in folder (250 of them!), copy data from B3,G3,B7,R7 in files, and paste data into wbThis in A1,B1,C1,D1. Next file into wbThis in next available row. VBA copies ok, but for each run the data just builds up. On file no 2, it paste data to wbThis into cells B2,B2,C2,D2,E2,F2,G2,H2. Data in B2:D2 is the same data that was copied from file no 1. What is happening? And how can I prevent the array from doing this?

Answer 1

Your variable i isn't ever getting reset to zero - so for each new workbook you open, it just adds more and more data to the same array.

Just before the end of the loop, insert these lines;

ReDim Data(1 to 1) '  Empties current data from the array, so it won't get re-used
i = 0              '  Empties the i variable so next sheet's data gets copied to 
                   '    the correct columns (starting at column A)