need code help or correction

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,232
Can any one pls help here..
Filter Col AB as a blank values. Select first row after header and give cell name as "False". Then copy this "False" value for rest of the filtered rows.

VBA Code:
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count

Range("AB1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=28, Criteria1:="="

Dim r As Long
r = Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1).Row

Range("AB" & r).Select
ActiveCell.FormulaR1C1 = "FALSE"

'To get last row number after filter the COl AB
Dim FinalRowFiltered As Long, dataRange As Range
Set dataRange = Range("$AB$2:$AB$" & LastRow)
With dataRange.SpecialCells(xlCellTypeVisible)
    FinalRowFiltered = .Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count
    'MsgBox FinalRowFiltered
End With

Range("AB" & r).Select
Selection.Copy
'instead of below line..
Range("AB3:AB" & FinalRowFiltered).Select
'I need in this way
Range("AB"&r+1 ":" "AB" & FinalRowFiltered).Select

Selection.SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("AB1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=28, Criteria1:="False"
 
Hi All, sorry for late post. I was on leave for 3 day and got just time to put here. This is my entire code (some few 4-5 lines at the end are remaining) but this is so far.. Could you please give me some nice code for below code. I want to see what expert techniques you're using for the basic code generally I try..

VBA Code:
Sub Button2_Click()
Dim WB As Workbook, WB_temp As Workbook, WB_PP As Workbook

Set WB = Workbooks.Open(Range("E3").Value)

Dim LastColumn As Long
ActiveSheet.UsedRange 'Refresh UsedRange
LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
Range("A5:AM" & LastColumn).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    Cells.Select
    Selection.ColumnWidth = 10.73

Application.CutCopyMode = False

Range("L1").Select
ActiveCell.FormulaR1C1 = "L"
Range("M1").Select

Columns("AF:AF").Select
Selection.Delete Shift:=xlToLeft

Range("AF1").Select
Selection.AutoFilter

Dim LastRow As Long
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count

Range("C1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Range("C1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3

LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
Range("N1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Range("N1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14

LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
Range("Y1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
Range("Z1").Select
ActiveSheet.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Range("Z1").Select
ActiveSheet.ShowAllData

On Error Resume Next
Range("AB1:AB" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "'False"
On Error GoTo 0
'same working like above line of code..
'Dim sh As Worksheet, fRng As Range, LstRw As Long
'Set sh = ActiveSheet
'With sh
'    LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
'    .Range("A1").AutoFilter Field:=28, Criteria1:="="
'    On Error Resume Next
'    Set fRng = .Range("AB2:AB" & LastRow).SpecialCells(xlCellTypeVisible)
'    On Error GoTo 0
'    If Not fRng Is Nothing Then
'        fRng.Value = "False"
'    End If
'    If .AutoFilterMode = True Then .AutoFilterMode = False
'End With

Columns("AC:AC").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("AD:AD").Select
Selection.TextToColumns Destination:=Range("AD1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("AE:AE").Select
Selection.TextToColumns Destination:=Range("AE1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Range("A1").Select
Selection.AutoFilter
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count

Set WB_temp = Workbooks.Open(Filename:="D:\Path\Template.xlsm")

WB.Activate
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
WB_temp.Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("AO2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Range("AO3:AO" & LastRow + 3).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("A1:BK" & LastRow + 3).Select
Selection.Copy

WB.Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.Zoom = 90
ActiveWindow.Zoom = 80
Application.CutCopyMode = False
Cells.Select
Selection.ColumnWidth = 9.55
Selection.End(xlToLeft).Select

    Rows("2:3").Select
    Selection.Delete Shift:=xlUp

Cells.Select
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    
Selection.End(xlToRight).Select

Columns("AX:BA").Select
Selection.Delete Shift:=xlToLeft

Columns("BF:BF").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    Range("BD1:BE1").Select
    'Range(Selection, Selection.End(xlDown)).Select
    Range("BD1:BE" & LastRow + 1).Select
    Selection.Copy
    
    Range("BF1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Set WB_PP = Workbooks.Open(Filename:="D:\Path\PP.xlsx")
    WB_PP.Activate
    Dim end_row As Long
    end_row = Range("A").End(xlDown).Count
    
    Range("A" & end_row + 1).Select
    
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    
    Rows("end_row+1 : end_row+2").Select
    Selection.Delete Shift:=xlUp
    
End Sub
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
It looks you started with a recorded macro.
The first step after recording a macro is generally to make the ranges dynamic.
It looks like you have done this with your last row and last column lines.
For last row you have used something like this:
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
It is more commonly done using this:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

The next step is to get rid of as many instances of Select & Activate as you can.
These statements slow down the code and make the code hard to read since it is often hard to keep track of what is active or selected.

The easy replacements are where you see this:
1659500846249.png

You can just replace it with:
Columns("AF:AF").Delete Shift:=xlToLeft

The next thing you can do is use With / End With for common objects which can make it easier to read and the code will run faster.

Without having you data I can't test the below and it is not a rewrite of your code, it is just implementing the above.
I can't test if fully so just see how you go with it.

Not sure if one of the other guys wants to do more,

VBA Code:
Sub Button2_Click_v02()
Dim WB As Workbook, WB_temp As Workbook, WB_PP As Workbook
Dim WS_Main As Worksheet, WS_CopyWS, WS_Copytemp, WS_temp As Worksheet, WS_PP As Worksheet

Set WB = Workbooks.Open(Range("E3").Value)
ActiveSheet.UsedRange 'Refresh UsedRange
Set WS_Main = ActiveSheet

Dim LastColumn As Long

With WS_Main
    LastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
    .Range("A5:AM" & LastColumn).Copy
    Sheets.Add After:=WS_Main
End With

Set WS_CopyWS = ActiveSheet

With WS_CopyWS
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    .Cells.ColumnWidth = 10.73
    
    Application.CutCopyMode = False
    
    .Range("L1").Value = "L"
    .Columns("AF:AF").Delete Shift:=xlToLeft
    .Range("AF1").AutoFilter
    
    Dim LastRow As Long
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
    
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
    
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .ShowAllData
    
    On Error Resume Next
    .Range("AB1:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "'False"
    On Error GoTo 0

    'same working like above line of code..
    'Dim sh As Worksheet, fRng As Range, LstRw As Long
    'Set sh = ActiveSheet
    'With sh
    '    LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    '    .Range("A1").AutoFilter Field:=28, Criteria1:="="
    '    On Error Resume Next
    '    Set fRng = .Range("AB2:AB" & LastRow).SpecialCells(xlCellTypeVisible)
    '    On Error GoTo 0
    '    If Not fRng Is Nothing Then
    '        fRng.Value = "False"
    '    End If
    '    If .AutoFilterMode = True Then .AutoFilterMode = False
    'End With
    
    .Columns("AC:AC").TextToColumns Destination:=.Range("AC1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AD:AD").TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AE:AE").TextToColumns Destination:=.Range("AE1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    
    .Range("A1").AutoFilter
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastColumn = .Range("A1", .Range("A" & .Columns.Count).End(xlUp)).Column
End With

Set WB_temp = Workbooks.Open(Filename:="D:\Path\Template.xlsm")
Set WS_temp = WB_temp.ActiveSheet

With WS_CopyWS
    .Range(.Cells(1, "A"), .Cells(LastRow, LastColumn)).Copy
End With
    
With WS_temp
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    .Range(.Range("AO2"), .Range("AO2").End(xlToRight)).Copy
    .Range("AO3:AO" & LastRow + 3).Paste
    Application.CutCopyMode = False
    
    .Range("A1:BK" & LastRow + 3).Copy
End With


WB.Sheets.Add After:=WS_CopyWS
Set WS_Copytemp = ActiveSheet

With WS_Copytemp
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    Application.CutCopyMode = False
    .Cells.ColumnWidth = 9.55
    .Rows("2:3").Delete Shift:=xlUp
    
    .Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
    .Columns("AX:BA").Delete Shift:=xlToLeft
    
    .Columns("BF:BF").Insert Shift:=xlToRight
    .Columns("BF:BF").Insert Shift:=xlToRight
        
    .Range("BD1:BE" & LastRow + 1).Copy
    .Range("BF1").Paste
    Application.CutCopyMode = False
    
    Dim lr As Long, lc As Long
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
    .Range(.Cells(1, "A"), .Cells(lr, lc)).Copy
End With
    
    
Set WB_PP = Workbooks.Open(Filename:="D:\Path\PP.xlsx")
Set WS_PP = ActiveSheet
With WS_PP
    Dim end_row As Long
    end_row = .Range("A").End(xlDown).Row
    
    .Range("A" & end_row + 1).Paste
    Application.CutCopyMode = False
    
    .Rows("end_row+1 : end_row+2").Delete Shift:=xlUp
End With

End Sub
 
Upvote 0
It looks you started with a recorded macro.
The first step after recording a macro is generally to make the ranges dynamic.
It looks like you have done this with your last row and last column lines.
For last row you have used something like this:
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
It is more commonly done using this:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

The next step is to get rid of as many instances of Select & Activate as you can.
These statements slow down the code and make the code hard to read since it is often hard to keep track of what is active or selected.

The easy replacements are where you see this:
View attachment 70684
You can just replace it with:
Columns("AF:AF").Delete Shift:=xlToLeft

The next thing you can do is use With / End With for common objects which can make it easier to read and the code will run faster.

Without having you data I can't test the below and it is not a rewrite of your code, it is just implementing the above.
I can't test if fully so just see how you go with it.

Not sure if one of the other guys wants to do more,

VBA Code:
Sub Button2_Click_v02()
Dim WB As Workbook, WB_temp As Workbook, WB_PP As Workbook
Dim WS_Main As Worksheet, WS_CopyWS, WS_Copytemp, WS_temp As Worksheet, WS_PP As Worksheet

Set WB = Workbooks.Open(Range("E3").Value)
ActiveSheet.UsedRange 'Refresh UsedRange
Set WS_Main = ActiveSheet

Dim LastColumn As Long

With WS_Main
    LastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
    .Range("A5:AM" & LastColumn).Copy
    Sheets.Add After:=WS_Main
End With

Set WS_CopyWS = ActiveSheet

With WS_CopyWS
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    .Cells.ColumnWidth = 10.73
   
    Application.CutCopyMode = False
   
    .Range("L1").Value = "L"
    .Columns("AF:AF").Delete Shift:=xlToLeft
    .Range("AF1").AutoFilter
   
    Dim LastRow As Long
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
   
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .ShowAllData
   
    On Error Resume Next
    .Range("AB1:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "'False"
    On Error GoTo 0

    'same working like above line of code..
    'Dim sh As Worksheet, fRng As Range, LstRw As Long
    'Set sh = ActiveSheet
    'With sh
    '    LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    '    .Range("A1").AutoFilter Field:=28, Criteria1:="="
    '    On Error Resume Next
    '    Set fRng = .Range("AB2:AB" & LastRow).SpecialCells(xlCellTypeVisible)
    '    On Error GoTo 0
    '    If Not fRng Is Nothing Then
    '        fRng.Value = "False"
    '    End If
    '    If .AutoFilterMode = True Then .AutoFilterMode = False
    'End With
   
    .Columns("AC:AC").TextToColumns Destination:=.Range("AC1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AD:AD").TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AE:AE").TextToColumns Destination:=.Range("AE1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
   
    .Range("A1").AutoFilter
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastColumn = .Range("A1", .Range("A" & .Columns.Count).End(xlUp)).Column
End With

Set WB_temp = Workbooks.Open(Filename:="D:\Path\Template.xlsm")
Set WS_temp = WB_temp.ActiveSheet

With WS_CopyWS
    .Range(.Cells(1, "A"), .Cells(LastRow, LastColumn)).Copy
End With
   
With WS_temp
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
    .Range(.Range("AO2"), .Range("AO2").End(xlToRight)).Copy
    .Range("AO3:AO" & LastRow + 3).Paste
    Application.CutCopyMode = False
   
    .Range("A1:BK" & LastRow + 3).Copy
End With


WB.Sheets.Add After:=WS_CopyWS
Set WS_Copytemp = ActiveSheet

With WS_Copytemp
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    Application.CutCopyMode = False
    .Cells.ColumnWidth = 9.55
    .Rows("2:3").Delete Shift:=xlUp
   
    .Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
       
    .Columns("AX:BA").Delete Shift:=xlToLeft
   
    .Columns("BF:BF").Insert Shift:=xlToRight
    .Columns("BF:BF").Insert Shift:=xlToRight
       
    .Range("BD1:BE" & LastRow + 1).Copy
    .Range("BF1").Paste
    Application.CutCopyMode = False
   
    Dim lr As Long, lc As Long
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
    .Range(.Cells(1, "A"), .Cells(lr, lc)).Copy
End With
   
   
Set WB_PP = Workbooks.Open(Filename:="D:\Path\PP.xlsx")
Set WS_PP = ActiveSheet
With WS_PP
    Dim end_row As Long
    end_row = .Range("A").End(xlDown).Row
   
    .Range("A" & end_row + 1).Paste
    Application.CutCopyMode = False
   
    .Rows("end_row+1 : end_row+2").Delete Shift:=xlUp
End With

End Sub
Thank You so much Alex.. 🙇‍♂️ Your explanation like gifting words for me.. I need / looking exactly guidance (teaching) like this..

Let me try the update code which you shared.

One thing I want to highlight that (whenever possible for me I tell this), since 2011 I'm in this forum, I really got very good help whenever I needed, and I'm really glad about the same. I got replies from so many be-loved experts from this group and always pray for them for good life.. 🙂

Now question is why then I'm not able to learn till now, is b'coz really cant find the way, the way you think to write the code and I'm still waiting for myself to be good in vba coding.. really hoping in this human journey I will be..

Thanks again..!!
 
Upvote 0
It looks you started with a recorded macro.
The first step after recording a macro is generally to make the ranges dynamic.
It looks like you have done this with your last row and last column lines.
For last row you have used something like this:
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
It is more commonly done using this:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

The next step is to get rid of as many instances of Select & Activate as you can.
These statements slow down the code and make the code hard to read since it is often hard to keep track of what is active or selected.

The easy replacements are where you see this:
View attachment 70684
You can just replace it with:
Columns("AF:AF").Delete Shift:=xlToLeft

The next thing you can do is use With / End With for common objects which can make it easier to read and the code will run faster.

Without having you data I can't test the below and it is not a rewrite of your code, it is just implementing the above.
I can't test if fully so just see how you go with it.

Not sure if one of the other guys wants to do more,

VBA Code:
Sub Button2_Click_v02()
Dim WB As Workbook, WB_temp As Workbook, WB_PP As Workbook
Dim WS_Main As Worksheet, WS_CopyWS, WS_Copytemp, WS_temp As Worksheet, WS_PP As Worksheet

Set WB = Workbooks.Open(Range("E3").Value)
ActiveSheet.UsedRange 'Refresh UsedRange
Set WS_Main = ActiveSheet

Dim LastColumn As Long

With WS_Main
    LastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
    .Range("A5:AM" & LastColumn).Copy
    Sheets.Add After:=WS_Main
End With

Set WS_CopyWS = ActiveSheet

[COLOR=rgb(226, 80, 65)]With WS_CopyWS
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False[/COLOR]
    ActiveWindow.Zoom = 80
    .Cells.ColumnWidth = 10.73
   
    Application.CutCopyMode = False
   
    .Range("L1").Value = "L"
    .Columns("AF:AF").Delete Shift:=xlToLeft
    .Range("AF1").AutoFilter
   
    Dim LastRow As Long
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
   
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .ShowAllData
   
    On Error Resume Next
    .Range("AB1:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "'False"
    On Error GoTo 0

    'same working like above line of code..
    'Dim sh As Worksheet, fRng As Range, LstRw As Long
    'Set sh = ActiveSheet
    'With sh
    '    LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    '    .Range("A1").AutoFilter Field:=28, Criteria1:="="
    '    On Error Resume Next
    '    Set fRng = .Range("AB2:AB" & LastRow).SpecialCells(xlCellTypeVisible)
    '    On Error GoTo 0
    '    If Not fRng Is Nothing Then
    '        fRng.Value = "False"
    '    End If
    '    If .AutoFilterMode = True Then .AutoFilterMode = False
    'End With
   
    .Columns("AC:AC").TextToColumns Destination:=.Range("AC1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AD:AD").TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AE:AE").TextToColumns Destination:=.Range("AE1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
   
    .Range("A1").AutoFilter
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastColumn = .Range("A1", .Range("A" & .Columns.Count).End(xlUp)).Column
End With

Set WB_temp = Workbooks.Open(Filename:="D:\Path\Template.xlsm")
Set WS_temp = WB_temp.ActiveSheet

With WS_CopyWS
    .Range(.Cells(1, "A"), .Cells(LastRow, LastColumn)).Copy
End With
   
With WS_temp
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
    .Range(.Range("AO2"), .Range("AO2").End(xlToRight)).Copy
    .Range("AO3:AO" & LastRow + 3).Paste
    Application.CutCopyMode = False
   
    .Range("A1:BK" & LastRow + 3).Copy
End With


WB.Sheets.Add After:=WS_CopyWS
Set WS_Copytemp = ActiveSheet

With WS_Copytemp
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    Application.CutCopyMode = False
    .Cells.ColumnWidth = 9.55
    .Rows("2:3").Delete Shift:=xlUp
   
    .Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
       
    .Columns("AX:BA").Delete Shift:=xlToLeft
   
    .Columns("BF:BF").Insert Shift:=xlToRight
    .Columns("BF:BF").Insert Shift:=xlToRight
       
    .Range("BD1:BE" & LastRow + 1).Copy
    .Range("BF1").Paste
    Application.CutCopyMode = False
   
    Dim lr As Long, lc As Long
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
    .Range(.Cells(1, "A"), .Cells(lr, lc)).Copy
End With
   
   
Set WB_PP = Workbooks.Open(Filename:="D:\Path\PP.xlsx")
Set WS_PP = ActiveSheet
With WS_PP
    Dim end_row As Long
    end_row = .Range("A").End(xlDown).Row
   
    .Range("A" & end_row + 1).Paste
    Application.CutCopyMode = False
   
    .Rows("end_row+1 : end_row+2").Delete Shift:=xlUp
End With

End Sub
Alex, Just trying the code and looks some thing weird happening on below mentioned step..
VBA Code:
With WS_CopyWS
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

When we're copying raw data to new sheet, the below steps already performing when its pasting the data.. it means, Test are removed, Canceled are removed, Sys Acc removed after the paste where row record are available from WS_main..
No. 1] -- .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
No. 2] -- .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
No. 3] -- .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
 
Upvote 0
I am not 100% sure I understand what you are saying but the line you are referring looks to be the replacement of the Line in yellow below in your original code which is run "before" the filter & delete lines you are referring to.

1659526688889.png
 
Upvote 0
I am not 100% sure I understand what you are saying but the line you are referring looks to be the replacement of the Line in yellow below in your original code which is run "before" the filter & delete lines you are referring to.

View attachment 70705
Yes, what you said and showing is correct.. but I can observe here that, after paste the data which we need filter and delete is not there.
So may be we need to comment this section .. ?? Is it.. ??

this..

.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
.Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3

LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
.Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14

LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
.Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
.Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
.ShowAllData
 
Upvote 0
Are you able to give us a realistic XL2BB sample of your Source Data sheet ?
Firstly showing that the data you need to delete is there are the start and so that we have some test data to run the code against.

If the code is working correctly and is erroring out because the rows you are filtering on aren't in the data set. We can put in some error handling so that it doesn't crash the code,

For a quick and dirty fix, we could wrap it in an On Error Resume Next as in the below:

VBA Code:
On Error Resume Next
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
    
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
    
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
On Error Goto 0
    .ShowAllData
 
Upvote 0
Are you able to give us a realistic XL2BB sample of your Source Data sheet ?
Firstly showing that the data you need to delete is there are the start and so that we have some test data to run the code against.

If the code is working correctly and is erroring out because the rows you are filtering on aren't in the data set. We can put in some error handling so that it doesn't crash the code,

For a quick and dirty fix, we could wrap it in an On Error Resume Next as in the below:

VBA Code:
On Error Resume Next
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
On Error Goto 0
    .ShowAllData
Alex, Thank You for your kind suggestion and explanation. I really appreciate your patience..

sharing file could be difficult for me, but I will create some sample view here in edit mode.

one quick question please, why you wrote on error goto 0 and not 1 or any other number..?
 
Upvote 0
The default for VBA is to have "no" error handling, which means that if an error occurs you get a VBA error message and the code stops.
There are a number of alternative On Error GoTo statements you can use to tell VBA what to do when an error occurs.
One of these is to ignore the error and just keep going which is what On Error Resume Next does.
You don't want to leave the "ignore error" setting turned on, you just want to use it for those lines that you know might fail but it is safe to keep going eg if the rows you want to delete aren't there keep going.
As soon as you get past those lines of code, you want to turn the Error handling back to the default state (stop the code if an error occurs)
That is what On Error GoTo 0 does.

See Microsoft documentation:= On Error statement (VBA)

1659534067166.png


See also
VBA ERROR Handling

PS: I am login off for the night.
 
Upvote 0
It looks you started with a recorded macro.
The first step after recording a macro is generally to make the ranges dynamic.
It looks like you have done this with your last row and last column lines.
For last row you have used something like this:
LastRow = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count
It is more commonly done using this:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

The next step is to get rid of as many instances of Select & Activate as you can.
These statements slow down the code and make the code hard to read since it is often hard to keep track of what is active or selected.

The easy replacements are where you see this:
View attachment 70684
You can just replace it with:
Columns("AF:AF").Delete Shift:=xlToLeft

The next thing you can do is use With / End With for common objects which can make it easier to read and the code will run faster.

Without having you data I can't test the below and it is not a rewrite of your code, it is just implementing the above.
I can't test if fully so just see how you go with it.

Not sure if one of the other guys wants to do more,

VBA Code:
Sub Button2_Click_v02()
Dim WB As Workbook, WB_temp As Workbook, WB_PP As Workbook
Dim WS_Main As Worksheet, WS_CopyWS, WS_Copytemp, WS_temp As Worksheet, WS_PP As Worksheet

Set WB = Workbooks.Open(Range("E3").Value)
ActiveSheet.UsedRange 'Refresh UsedRange
Set WS_Main = ActiveSheet

Dim LastColumn As Long

With WS_Main
    LastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
    .Range("A5:AM" & LastColumn).Copy
    Sheets.Add After:=WS_Main
End With

Set WS_CopyWS = ActiveSheet

With WS_CopyWS
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    .Cells.ColumnWidth = 10.73
   
    Application.CutCopyMode = False
   
    .Range("L1").Value = "L"
    .Columns("AF:AF").Delete Shift:=xlToLeft
    .Range("AF1").AutoFilter
   
    Dim LastRow As Long
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
   
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3, Criteria1:="Test"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=3
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14, Criteria1:="Canceled"
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=14
   
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=25, Criteria1:="Sys Acc"
    .Range("$A$1:$AM$" & LastRow).AutoFilter Field:=26, Criteria1:="="
    .Range("A2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    .ShowAllData
   
    On Error Resume Next
    .Range("AB1:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) = "'False"
    On Error GoTo 0

    'same working like above line of code..
    'Dim sh As Worksheet, fRng As Range, LstRw As Long
    'Set sh = ActiveSheet
    'With sh
    '    LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    '    .Range("A1").AutoFilter Field:=28, Criteria1:="="
    '    On Error Resume Next
    '    Set fRng = .Range("AB2:AB" & LastRow).SpecialCells(xlCellTypeVisible)
    '    On Error GoTo 0
    '    If Not fRng Is Nothing Then
    '        fRng.Value = "False"
    '    End If
    '    If .AutoFilterMode = True Then .AutoFilterMode = False
    'End With
   
    .Columns("AC:AC").TextToColumns Destination:=.Range("AC1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AD:AD").TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    .Columns("AE:AE").TextToColumns Destination:=.Range("AE1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
   
    .Range("A1").AutoFilter
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastColumn = .Range("A1", .Range("A" & .Columns.Count).End(xlUp)).Column
End With

Set WB_temp = Workbooks.Open(Filename:="D:\Path\Template.xlsm")
Set WS_temp = WB_temp.ActiveSheet

With WS_CopyWS
    .Range(.Cells(1, "A"), .Cells(LastRow, LastColumn)).Copy
End With
   
With WS_temp
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
    .Range(.Range("AO2"), .Range("AO2").End(xlToRight)).Copy
    .Range("AO3:AO" & LastRow + 3).Paste
    Application.CutCopyMode = False
   
    .Range("A1:BK" & LastRow + 3).Copy
End With


WB.Sheets.Add After:=WS_CopyWS
Set WS_Copytemp = ActiveSheet

With WS_Copytemp
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 80
    Application.CutCopyMode = False
    .Cells.ColumnWidth = 9.55
    .Rows("2:3").Delete Shift:=xlUp
   
    .Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
       
    .Columns("AX:BA").Delete Shift:=xlToLeft
   
    .Columns("BF:BF").Insert Shift:=xlToRight
    .Columns("BF:BF").Insert Shift:=xlToRight
       
    .Range("BD1:BE" & LastRow + 1).Copy
    .Range("BF1").Paste
    Application.CutCopyMode = False
   
    Dim lr As Long, lc As Long
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
    .Range(.Cells(1, "A"), .Cells(lr, lc)).Copy
End With
   
   
Set WB_PP = Workbooks.Open(Filename:="D:\Path\PP.xlsx")
Set WS_PP = ActiveSheet
With WS_PP
    Dim end_row As Long
    end_row = .Range("A").End(xlDown).Row
   
    .Range("A" & end_row + 1).Paste
    Application.CutCopyMode = False
   
    .Rows("end_row+1 : end_row+2").Delete Shift:=xlUp
End With

End Sub
Alex, I'm getting error.. object dosent support this property or method.. on 2nd line..
.Range(.Range("AO2"), .Range("AO2").End(xlToRight)).Copy
--> .Range(("AO3:AO" & LastRow + 3)).Paste
I tried this also,
.Range(.Range("AO3"), .Range("AO" & LastRow + 3)).Paste
but not worked..
 
Upvote 0

Forum statistics

Threads
1,215,161
Messages
6,123,371
Members
449,097
Latest member
thnirmitha

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top