Search ListBox, Move Data and Delete Source Data

This is the code I currently have but if I search the list and chose the records to archive it copies the data to sheet4 but deletes data from the top of sheet1 even if the data copied is from further down the sheet.

Please Login or Register  to view this content.

Private Sub TextBox10_Change()
Dim J As Long
Dim testString As String


testString = LCase("*" & TextBox10.text & "*")


With ListBox1
For J = .ListCount - 1 To 0 Step -1
If (Not (LCase(.List(J, 0)) Like testString) And (Not (LCase(.List(J, 1)) Like testString))) _
And (Not (LCase(.List(J, 2)) Like testString) And (Not (LCase(.List(J, 3)) Like testString))) Then
.RemoveItem J
End If
Next J
End With
End Sub


Private Sub UserForm_Initialize()
With Sheet1
ListBox1.ColumnCount = 11
ListBox1.List = Sheets("HERS Data").Range("A2:K" & Sheets("HERS Data").Cells(Rows.Count, 1).End(xlUp).Row).value

End With

End Sub

Private Sub cmdArchive_Click()
Dim lRw As Long
Dim iX As Integer, iY As Integer
Dim indexi As Long
For iX = 0 To ListBox1.ListCount - 1
If Me.ListBox1.Selected(iX) = True Then
With Sheet4
lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For iY = 0 To Me.ListBox1.ColumnCount - 1
.Cells(lRw, iY + 1).value = Me.ListBox1.List(iX, iY)


Next iY
End With

End If





Next iX


Dim I As Long





With ListBox1
For I = .ListCount - 1 To 0 Step -1
If .Selected(I) Then
.RemoveItem I
Sheets("HERS Data").Rows(I + 2).EntireRow.Delete

End If
Next I

End With

Unload Me
ArchiveOperative.Show

End Sub

Please Login or Register  to view this content.

Many Thanks

Andy

Duplicate post deleted