CODEWITHSUNDEEP
vbaexcel
Deanna Ellis
Deanna Ellis

Reputation: 1

Macro works on my Excel but not someone elses

I created the macro below. It is supposed to find a specific row according, copy it, delete it and paste it onto a separate sheet in the same workbook.

It works perfectly fine for me but not my associate. The code in green works and moves the rows properly and the code in red does not work. It finds the rows and deletes them but doesn't move them to the other sheet.

Screenshot of Code

Actual code:

 With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*L5P*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 6.0L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 7.3L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Nissan Titan*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

This person has the same version of Excel as me and is running Windows 10 like me as well.

Ideas?

Upvotes: 0

Views: 362

Answers (3)

CLR
CLR

Reputation: 12289

I suspect that the issue is that on your associate's machine, the filter being applied isn't finished before the data is copied. Adding a DoEvents in just after the filter application should cause everything to stop and wait for the filter to finish.

While I'm there, I also shortened the process slightly:

Sub test_this()

    Dim fltr As Variant

    With ActiveSheet

        For Each fltr In Array("*L5P*", "*Powerstroke 6.0L*", "*Powerstroke 7.3L*", "*Nissan Titan*")

          If .AutoFilterMode Then .AutoFilterMode = False
          DoEvents 'make sure removing filter finishes
          .Range("A1:Q1").AutoFilter 8, fltr
          DoEvents 'make sure applying filter finishes
          With .AutoFilter.Range.Offset(1)
             .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
             .EntireRow.Delete
          End With
          .AutoFilterMode = False
          DoEvents 'make sure removing filter finishes
        Next

    End With

End Sub

EDIT: Sorry, I had a rethink. I think it's important to DoEvents after each filter change, rather than just when one is applied. Code changed to do this.

Upvotes: 1

Mathieu Guindon
Mathieu Guindon

Reputation: 71227

That's some redundant code. Take any of these blocks and extract it into its own parameterized procedure:

Private Sub CopyAndFilter(ByVal fromSheet As Worksheet, ByVal toSheet As Workshet, ByVal filter As String)
    With fromSheet
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:Q1").AutoFilter 8, filter
      With .AutoFilter.Range.Offset(1)
         .Copy toSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
         .EntireRow.Delete
      End With
      .AutoFilterMode = False
    End With
End Sub

Now your calling code would be:

Dim source As Worksheet
Set source = ActiveSheet

Dim destination As Worksheet
Set destination = ThisWorkbook.Worksheets("L5p Orders")

CopyAndFilter source, destination, "*L5P*"
CopyAndFilter source, destination, "*Powerstroke 6.0L*"
CopyAndFilter source, destination, "*Powerstroke 7.3L*"
CopyAndFilter source, destination, "*Nissan Titan*"

That way you're only dereferencing the source and destination sheets once, and you greatly reduce the duplication, thus ensuring that all blocks work identically.

Upvotes: 5

Tim Williams
Tim Williams

Reputation: 166835

Not an answer but your code would be more manageable as:

For Each t In Array("*L5P*", "*Powerstroke 6.0L*", "*Powerstroke 7.3L*", "*Nissan Titan*")

    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A1:Q1").AutoFilter 8, t
        With .AutoFilter.Range.Offset(1)
           .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
           .EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With

Next t

...and you can be sure each term gets the exact same treatment...

Upvotes: 3

Related Questions