Storing multiple values in variant and delete rows at the end of sub

Question

I have written the following code which is supposed to run through a data set and delete all rows that do not match the value in call C1. In my original code I deleted line by line and the code was very slow, so now I am trying to add all values to a variant and delete all cells at the end. Is this possible?

Sub FixData()

Dim wbFeeReport As Workbook
Dim wsData As Worksheet
Dim wsData2 As Worksheet
Dim FrRngCount As Range
Dim x As Long
Dim y As Long
Dim varRows As Variant

Set wbFeeReport = ThisWorkbook
Set wsData = wbFeeReport.Worksheets("Data")
Set wsData2 = wbFeeReport.Worksheets("Data2")

Set FrRngCount = wsData.Range("D:D")
y = Application.WorksheetFunction.CountA(FrRngCount)

For x = y To 2 Step -1
If wsData.Range("J" & x).Value <> wsData2.Range("C1").Value Then
varRows = x
Else
wsData.Range("AF" & x).Value = wsData.Range("J" & x).Value
End If
Next x

wsData.Rows(varRows).EntireRow.Delete

End Sub

Right now the code only deletes the last row as the variant is overwritten each time as it runs through the loop. Any suggestions on how I can store all values in the variant and delete the rows I don't need at the end?

Thanks for you help!

Use the Union method to collect all of the cells into a single Range object then use rng.entirerow.delete. — user4039065
– user4039065, Commented Oct 5, 2016 at 16:59

user6432984 · Accepted Answer · 2016-10-05 19:46:20Z

1

The fastest way is to

Load the data into an array
Copy the valid data into a second array
Clear the contents of the range
Write the second array back to the worksheet

Sub FixData()
    Dim Source As Range
    Dim Data, Data1, TargetValue
    Dim x As Long, x1 As Long, y As Long

    Set Source = Worksheets("Data").Range("A1").CurrentRegion
    TargetValue = Worksheets("Data2").Range("C1")

    Data = Source.Value
    ReDim Data1(1 To UBound(Data, 1), 1 To UBound(Data, 2))

    For x = 1 To UBound(Data, 1)
        If x = 1 Or Data(x, 10) = TargetValue Then
            x1 = x1 + 1
            For y = 1 To UBound(Data, 2)
                Data1(x1, y) = Data(x, y)
            Next
        End If
    Next

    Source.ClearContents
    Source.Resize(x1).Value = Data1

End Sub

answered Oct 5, 2016 at 19:46

user6432984

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

3 Comments

VBA Pete Over a year ago

Wow this is so quick! Thanks so much for your help Thomas.

VBA Pete Over a year ago

Quick question: How come Dim Data, Data1 & TargetValue do not have do be defined?

user6432984 Over a year ago

If you don't specify a declaration type, the variable type defaults to Variant.

Dirk Reichel · Accepted Answer · 2016-10-05 17:20:09Z

1

As you need a range holding all rows, you can collect it in one "on the run" like this:

Sub FixData()

  Dim wsData As Worksheet
  wsData = ThisWorkbook.Worksheets("Data")

  Dim val As Variant
  val = ThisWorkbook.Worksheets("Data2").Range("C1").Value

  Dim DelRows As Range, x As Long

  For x = 2 To wsData.Cells(wsData.Rows.Count, 4).End(xlUp).Row
    If wsData.Range("J" & x).Value <> val Then
      If DelRows Is Nothing Then
        Set DelRows = wsData.Rows(x)
      Else
        Set DelRows = Union(wsData.Rows(x), DelRows)
      End If
    Else
      wsData.Range("AF" & x).Value = wsData.Range("J" & x).Value
    End If
  Next x

  DelRows.EntireRow.Delete

End Sub

answered Oct 5, 2016 at 17:20

Dirk Reichel

7,9991 gold badge18 silver badges31 bronze badges

1 Comment

VBA Pete Over a year ago

This is also a nice piece of code. Thanks for your help Dirk!

Collectives™ on Stack Overflow

Storing multiple values in variant and delete rows at the end of sub

2 Answers 2

3 Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related