0

I am trying to write a macro that establishes a list from a different file, before cross referencing the data set against the list so that it knows which rows of data to delete. this deleted data should also be cut and paste to a new sheet so it can be checked afterward. The macro then needs to go through a column of data and delete rows based on certain characters in the string. I have found a way to do this, and the above cut and paste, where after every If statement it cut and pastes the row into another sheet. This has however made the macro run time very long. I had a thought to add each of the rows to be deleted (due to the string conditions) to a list (deleted2) and then pasting this list into the other sheet at the end of the macro, but I cant figure out how to add the row and successfully paste the array. I have also tried to do this when cross referencing and deleting the rows (hence the deleted list). The logic being if it only has to go through the data set once it may speed the macro up.

I have stepped through the code and can see when the row is added, it gives load of random components to the item, but does not register any of the information. if anyone has any ideas as to fix this, or if there is a better way to speed up the original code it would be very much appreciated!

*Note, i have had to redact some information hence the weird label names at points.

Dim lastrow As Integer

Dim lastRowSL As Integer

Dim List1 As Object

Dim Deleted As Object

Dim Deleted2 As Object

Dim Code As String

Dim S As String


Sub Formatting()

'obtaining which securities are bonds
Workbooks.Open "File1"
        
'finding last row of the file1
lastRowSL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'creating the list to cross reference data against
Set List1 = CreateObject("System.Collections.ArrayList")


'adding to the list
For j = 1 To lastRowSL
    
    If Cells(j, 2) = "List" And Cells(j, 6) <> "F" Then
        S = Cells(j, 4)
        List1.Add S
    End If
       
Next j
    
Workbooks("File1.xlsx").Close savechanges:=False

ActiveWorkbook.Sheets("List").Activate

'obtaining the last row for cross referencing
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set Deleted = CreateObject("System.Collections.ArrayList")
Set Deleted2 = CreateObject("System.Collections.ArrayList")

'comparing data against values earlier established to see if they can be deleted, then analsysing the data to see if they can be deleted
'trying to add these to lists and then paste them after the for loop to speed the macro up - i can't figure out how to paste the list
For k = 10 To lastrow

Code = Cells(k, 4)

'adding deleted rows into another sheet for checking
' first if checks against the earlier established l;ist, all of the below should add the data row to one of the two lists, then delete that row in the main data.
    If List1.Contains(Code) Then
        Deleted.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 4) = "abcd" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 5) = "efghi" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 5) = "jklmn" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
 
    ElseIf Left(Cells(k, 2), 5) = "opqrs" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
     ElseIf Left(Cells(k, 2), 4) = "tuvwx" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
     ElseIf Left(Cells(k, 2), 5) = "yzabc" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
        
     ElseIf Right(Cells(k, 2), 3) = "def" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
    End If

Next k

'formatting data to make it easier to check
Sheets("Deleted").Activate
Range("A2") = Deleted.ToArray 'trying to paste the lists here
Range("A2:J" & lastRow2 + 1).Sort Key1:=Range("E1"), Order1:=xlAscending
Range("A:J").EntireColumn.AutoFit

Sheets("Deleted2").Activate
'code where other list will be pasted
Range("A2") = Deleted2.ToArray
Range("A2:J" & lastRow3 + 1).Sort Key1:=Range("B1"), Order1:=xlAscending
Range("A:J").EntireColumn.AutoFit

ActiveWorkbook.Sheets("List").Activate
Range("A10:J" & lastrow).Sort Key1:=Range("E9"), Order1:=xlAscending
Range("B:E").EntireColumn.AutoFit

End Sub
ms96
  • 1
  • 1
  • `deleteRange = Union(deleteRange, Rows(iterator))` would make your life a lot easier, provided you can work without the need for an array. – Cyril May 26 '22 at 17:11
  • Pasting an array with [`Transpose`](https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.transpose) may be what you're searching for. – Cyril May 26 '22 at 17:12
  • @Cyril thank you for your response, i am unfamiliar with the deleteRange line of code you have suggested, what does it do? Would this replace the Delete instructions following the Else if Statements? – ms96 May 27 '22 at 15:37
  • See https://stackoverflow.com/questions/47532541/how-to-delete-certain-ranges – Cyril May 27 '22 at 15:51

0 Answers0