Excel VBA Dynamic Code Repeat Failure

Question

This code is a bit complex but the problem with it is the second and third time it is run it will start to lose columns on the "Base434" worksheet that it pulls information from. I tried a quick fix of adding "Range("A1").Select so that anything previously highlighted couldn't throw it off but it keeps ditching the 20th row which is column "T". I have left all of the code below in hope that someone can find my bug. I just cannot sort it.

Essentially this code sorts set fields of data on an imported worksheet called "Base434", copies specific fields to another page which has some embeded formulas then checks to see if the worksheet "NoStdHC" exists. If it doesn't it will create said worksheet and add the header. Then move to the filtered worksheet called "Base434" and copy all visible cells in that worksheet. It will then paste those in the first available cell in column A of "NoStdHC". My issue is after running this once it refuses to copy the final column on the next "Base434" sheet that has been imported. Can anyone find the fault in my code? Yes I know a lot of this could be condensed if I were better at coding but I would prefer to understand what the code is doing which is why I have it written this way.

    Sub NoStdHC()
'
' NoStdHC Macro created by 
'

'
    Application.ScreenUpdating = False
    Sheets("Base434").Select
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=15
    ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10
    ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5", _
        Operator:=xlAnd
    Columns(11).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Processing").Select
    Range("AC1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C5").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTA(C[26])"
    Range("e5").Select
    ActiveCell.FormulaR1C1 = "=SUM(C[24])"
    Range("C8").Select
    Sheets("Base434").Select
    Dim wsTest As Worksheet
    Const strSheetName As String = "PR0OnStd"

    Set wsTest = Nothing
    On Error Resume Next
    Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
    On Error GoTo 0

    If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
    Sheets("Base434").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("PR0OnStd").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Range("A2").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    End If
    Sheets("Base434").Select
    Range("a1").Select
    Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("PR0OnStd").Select
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range("A" & LastRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.ScreenUpdating = True
End Sub'

Odd behavior is very likely to occur when using `Select/Activate/ActiveCell` and unqualified ranges (so extensively!). I urge you to read and apply [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) — A.S.H, May 24 '17 at 23:32
This is exactly my problem. Thank you for the link now I know how to avoid select. — Greg Herr, May 26 '17 at 13:08

score 2 · Answer 1 · answered May 25 '17 at 05:15

As commented by @A.S.H avoid using Select/Activate/ActiveCell if at all possible. Ranges should be qualified by using their sheet names. With...End With constructs achieve both of these goals. The With statement allows you to perform a series of statements on a specified object without requalifying the name of the object.

Indentation makes code much easier to read and understand.

With the foregoing in mind I think this code is understandable

Sub NoStdHC()
Dim LastRow As Long
Dim sht As Worksheet

Application.ScreenUpdating = False
With Sheets("Base434")
    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    .Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5"
    .Range(.Cells(2, 11), .Cells(LastRow, 11)).Copy
End With
With Sheets("Processing")
    .Range("AC1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    .Range("C5").FormulaR1C1 = "=COUNTA(C[26])"
    .Range("E5").FormulaR1C1 = "=SUM(C[24])"
End With
Dim wsTest As Worksheet
Const strSheetName As String = "PR0OnStd"
'Loop through sheets to find strSheetName
'if not found, then wsTest will be Nothing
For Each sht In ThisWorkbook.Sheets
    If sht.Name = strSheetName Then
        Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
        Exit For
    End If
Next
If wsTest Is Nothing Then
'Add the sheet, set up headings, column widths and frozen pane
    Worksheets.Add.Name = strSheetName
    With Sheets("Base434")
        .Range("A1", .Range("A1").End(xlToRight)).Copy
    End With
    With Sheets("PR0OnStd")
        .Range("A1").PasteSpecial xlPasteValues
        .UsedRange.Columns.AutoFit
    End With
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
End If
With Sheets("Base434")
    .Range(.Cells(2, 1), .Cells(LastRow, 2).End(xlToRight)).Copy
End With
With Sheets("PR0OnStd")
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Range("A" & LastRow).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True

End Sub

score 1 · Accepted Answer · answered May 25 '17 at 00:37

If you wanted to write write code you can easily understand you wouldn't write code like this:-

Sheets("Base434").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

This is what your code says, translated into plain language:-

Look at sheet "Base434"
Look at cell A1 (implied: in that sheet)
Look at what you are looking at and extend your view to the last ??? right
    (This is where the mistake is)
Copy what you are looking at.

Now, surely, if you wanted to understand what all this looking is aiming to do you might express the idea somewhat like this:-

Copy the cells in Row 1 of Sheet "Base434" from A1 to the end of the row.

With this kind of approach you would end up with code like this:-

Dim RangeToCopy As Range
Dim Cl As Long                              ' the last used column

With Worksheets("Base434")
    Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set RangeToCopy = .Range(.Cells(1, 1), .Cells(1, Cl))
End With
MsgBox "Range to copy = " & RangeToCopy.Address
RangeToCopy.Copy

Would you say that this code is harder to read and understand than your version? Well, it has three advantages, even if it is. One, it doesn't have the fault that yours has. Two, it never got near to wanting to make the mistake that your approach made. Three, whatever errors it might still contain are easy to find and quick to eliminate.

Besides, it runs faster.

Excel VBA Dynamic Code Repeat Failure

2 Answers2