Need a macro for filtering and pasting data

**skhande2** · 06-23-2023, 01:05 PM

Hi,

I need a macro that filters sheet 'Routing' by column E that starts with digit 6. It then filters column F by those that either start with a space. (or ones that don't start with number - your choice) It then copies the results and pastes it in sheet 'Outside processing' starting from cell B3. I also need the pasted result to have double lined border around it.

I've attached the sheet as reference. I've manually entered the results but you may delete the results in Outside Processing sheet (except column A) and see if it replicates it. Thank you!

testing 2.xlsx

**ORoos** · 06-24-2023, 12:45 AM

Hi there,

Please see attached file with macro.

To filter column 'E' numbers by the first digit (6), we convert the numbers first to 'Text' (convert back to 'General' at the end).
To filter column 'F' if the first digit is a number, I used a 'helper' formula in column 'K'. If you have other data there, move to the right of the last used column. This is deleted again at the end.

Not sure what you mean with double-lined borders. They are normally just available at the bottom of the cell...

There are probably more elegant solutions, but the code below should work.

Sub FilterData()

Dim lRow As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Use Helper column ('K' = change to last used column if there is other data)
' This is used to determin if column F value starts with a letter or number
    Range("K1").Value = "Helper"
    Range("K2").FormulaR1C1 = _
        "=IF(ISNUMBER(VALUE(LEFT(RC[-5], 1))),""Number"", ""Letter"")"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K" & lRow)
    

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True

    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=11, Criteria1:="Letter", Operator:=xlFilterValues
    End With

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy
    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

' Remove Helper column and reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
   
Sheet6.Select
    Application.CutCopyMode = False
        
Application.ScreenUpdating = True

End Sub

**skhande2** · 06-24-2023, 10:16 AM

If you look at routing sheet in the excel I uploaded you will see how there is a special border around the pasted range. I want that border when macro automatically pastes it.

**skhande2** · 06-26-2023, 12:33 PM

Actually, I solved the border thing but another issue I found is if there are any values in column K of sheeting routing, it gets deleted and all the columns to its right it shift 1 column to their left replacing column k after the macro is executed. Could you ensure this doesn't happen? Thanks!

**ORoos** · 06-26-2023, 10:32 PM

Originally Posted by skhande2

Actually, I solved the border thing but another issue I found is if there are any values in column K of sheeting routing, it gets deleted and all the columns to its right it shift 1 column to their left replacing column k after the macro is executed. Could you ensure this doesn't happen? Thanks!

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

With:
Columns("K:K").Clear

**johnnyL** · 06-26-2023, 09:17 PM

@skhande2, try the following vba code, it is only set up to work with your sample data, but it should give you the jist. You would also need to apply the grid lines if you want them, but it sounds like you already have a way to handle that:

Sub Test()
'
    With Sheets("Routing")
        .Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True '   Temporarily convert Column E on 'Routing' to text values
'
        .UsedRange.AutoFilter Field:=5, Criteria1:="6*", Operator:=xlFilterValues                           '   AutoFilter column E on 'Routing' for #s that start with '6'
        .UsedRange.AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues                           '   AutoFilter column F on 'Routing' for all non numeric values
'
        Sheets("Outside processing").Range("B3:K10").ClearContents                                          '   Clear previous data from 'Outside processing' range B3:K10

        .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Outside processing").Range("B3")            '   Copy the filtered data from 'Routing' to 'Outside processing' Range B3
'
        .UsedRange.AutoFilter                                                                               '   Remove the AutoFilter from 'Routing'
'
        With .Columns("E:E")                                                                                '   Return Column E of 'Routing' back from text to numbers
            .NumberFormat = "General"
            .Value = .Value
        End With
'
        With Sheets("Outside processing").Columns("F:F")                                                    '   Change Column F of 'Outside processing' from text to numbers
            .NumberFormat = "General"
            .Value = .Value
        End With
    End With
End Sub

**skhande2** · 06-27-2023, 08:39 AM

Thanks for the help but its still messing up column K. (tried both of your solutions..) I've uploaded the file with the actual data. In hindsight, maybe I should have done it to begin with. Thanks!
Practice.xlsx

**ORoos** · 06-27-2023, 09:24 AM

The updated code incorporates some of the code from "johnnyL". Thanks for a simpler solution without helper column!

Yes, uploading a sample reflecting the actual date is making it a lot easier to find a solution.
I also noted about using column K as a helper column in my

I used a 'helper' formula in column 'K'. If you have other data there, move to the right of the last used column

.

Still not sure about the double boarder thing, but I think you worked that part out yourself.

**skhande2** · 06-27-2023, 09:47 AM

My computer won't allow me to execute implanted macro for security reasons. Could you paste the macro here? Thanks!

**ORoos** · 06-27-2023, 09:56 AM

Sub FilterData()

Dim lRow As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy
    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

' Remove Helper column and reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
   
Sheet6.Select
    Application.CutCopyMode = False
        
Application.ScreenUpdating = True

End Sub

**skhande2** · 06-27-2023, 11:14 AM

Could you ensure numbers in column F in sheet 'Outside Processing' are converted back into numbers from text? Much Appreciated!

**skhande2** · 06-27-2023, 12:29 PM

Also, this is my solution to double borders. I applied it to other macros and it works just fine but for some reason, to this macro, it won't end by the last row

:

Sub FilterData()

Dim lRow As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy
    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

' Remove Helper column and reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
   
Sheet6.Select
    Application.CutCopyMode = False
        
Application.ScreenUpdating = True

    Dim pastedRange As Range
    Set pastedRange = Sheets("Outside processing").Range("B3:K10")  ' Update with the actual pasted range
    
    ' Apply double lined border to the outer edges of the range
    With pastedRange
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlDouble
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
End Sub

Rest of the macro is same, I just added the border part towards the end.

**johnnyL** · 06-27-2023, 02:29 PM

Here you go:

Sub Test2()
'
    With Sheets("Routing")
        .Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True '   Temporarily convert Column E on 'Routing' to text values
'
        .UsedRange.AutoFilter Field:=5, Criteria1:="6*", Operator:=xlFilterValues                           '   AutoFilter column E on 'Routing' for #s that start with '6'
        .UsedRange.AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues                           '   AutoFilter column F on 'Routing' for all non numeric values
'
        With Sheets("Outside processing")
            .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).ClearContents                          '   Clear previous data from 'Outside processing' range B3:K10
        End With
'
        .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy Sheets("Outside processing").Range("B3")  '   Copy the filtered data from 'Routing' to 'Outside processing' Range B3
'
        .UsedRange.AutoFilter                                                                               '   Remove the AutoFilter from 'Routing'
'
        With .Columns("E:E")                                                                                '   Return Column E of 'Routing' back from text to numbers
            .NumberFormat = "General"
            .Value = .Value
        End With
    End With
'
    With Sheets("Outside processing")
        With .Columns("F:F")                                                                                '   Change Column F of 'Outside processing' from text to numbers
            .NumberFormat = "General"
            .Value = .Value
        End With
'
        With .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders                                 '   Set borders for range B3:K10
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
'
        With .Range("K3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders(xlEdgeLeft)                     '   Set thick borders for range K3:K10 (left edge)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
'
        With .Range("K3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders(xlEdgeRight)                    '   Set thick borders for range K3:K10 (right edge)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
'
        With .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row)                                         '   Set double borders for the outside edges of range B3:K10
              .Borders(xlEdgeLeft).LineStyle = xlDouble
               .Borders(xlEdgeTop).LineStyle = xlDouble
             .Borders(xlEdgeRight).LineStyle = xlDouble
            .Borders(xlEdgeBottom).LineStyle = xlDouble
        End With
    End With
End Sub

**ORoos** · 06-27-2023, 07:48 PM

This will change column F back to numbers, make the 'double line' dynamic based on how many rows of test you have.
Also added as a separate routine, called from the code, to reset any previous 'double-lines' you had in the output sheet before the double line boarder is applied.

Sub FilterData()

Dim lRow As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy
    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

' Reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
   
   
Sheet6.Select
' Reverse column F back from 'Text' to 'General'
    Columns("F:f").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
        
        
    Dim pastedRange As Range
    Dim lRow2 As Long
    
    lRow2 = Cells(Rows.Count, 2).End(xlUp).Row  ' Find last used row in column B (A has formulas)
    
    Call ResetBorders  ' Reset borders before applying double ines to pasted range
    
    Set pastedRange = Sheet6.Range("B3:K" & lRow2) ' Will automatically update to pasted range
    
    ' Apply double lined border to the outer edges of the range
    With pastedRange
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlDouble
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
        
Application.ScreenUpdating = True

End Sub


Sub ResetBorders()

' Set all internal lines to 'Thin - single line'
    Range("B3:K13").Borders.LineStyle = Excel.XlLineStyle.xlContinuous
    
' Add 'thick' outside boarder for column K
    Range("K2:K13").Select
    
    With Selection
        .Borders(xlEdgeTop).LineStyle = xlSingle
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlSingle
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlSingle
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlSingle
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
    
End Sub

**skhande2** · 06-29-2023, 11:58 AM

Thanks guys! So both of your macros error if there are no numbers to copy and paste.

-JohnnyL, your macro copy paste the header from routing into row 3 of Outside processing and removes its header.
-ORoos, your macro errors (which stops other macros after it from executing that I've added to it) and corrupts the values in column E at the table in the bottom of Routing.

ORoos, as you edit your macro, please edit the version of it I created below. Thanks!

You can test this on the sheet I pasted earlier by removing the rows that get copy and pasted but I've uploaded a file without those for your ease. Mucho Appreciato!

Sub FilterData()
    Dim lRow As Long
    Dim wsRouting As Worksheet
    Dim wsOutsideProcessing As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsRouting = ThisWorkbook.Sheets("Routing")
    Set wsOutsideProcessing = ThisWorkbook.Sheets("Outside processing")
    
    wsOutsideProcessing.Range("B3:K13").ClearContents ' Clearing old values
    
    ' Reset AutoFilter to get last row with data
    wsRouting.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Reset AutoFilters (incl new helper column)
    ActiveSheet.Range("A1").AutoFilter
    
    ' Change Column E Numbers to Text for filtering with wildcard
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
        
    ' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With
    
    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy
    wsOutsideProcessing.Select
    
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    ' Reverse column E back from 'Text' to 'General'
    wsRouting.Select
    ActiveSheet.AutoFilterMode = False
    
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
    
    wsOutsideProcessing.Select
    
    ' Reverse column F back from 'Text' to 'General'
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
    
    Dim pastedRange As Range
    Dim lRow2 As Long
    
    lRow2 = wsOutsideProcessing.Cells(Rows.Count, 2).End(xlUp).Row ' Find last used row in column B (A has formulas)
    
    Set pastedRange = wsOutsideProcessing.Range("B3:K" & lRow2) ' Will automatically update to pasted range
    
    ' Apply double-lined border to the outer edges of the range
    With pastedRange
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlDouble
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
    
    Application.ScreenUpdating = True
End Sub

Welp.xlsx

**johnnyL** · 06-29-2023, 01:38 PM

@skhande2, I have come up with the following code that addresses the errors that you mentioned:

Sub Test3()
'
    With Sheets("Routing")
        If .AutoFilterMode Then .AutoFilterMode = False
'
        .Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True '   Temporarily convert Column E on 'Routing' to text values
'
        .UsedRange.AutoFilter Field:=5, Criteria1:="6*", Operator:=xlFilterValues                           '   AutoFilter column E on 'Routing' for #s that start with '6'
        .UsedRange.AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues                           '   AutoFilter column F on 'Routing' for all non numeric values
'
        With Sheets("Outside processing")
            If .Range("B" & .Rows.Count).End(xlUp).Row > 2 Then
                .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).ClearContents                      '       Clear previous data from 'Outside processing' range B3:K10
            End If
        End With
'
        If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then            '
            .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
                    Sheets("Outside processing").Range("B3")                                                '       Copy the filtered data from 'Routing' to 'Outside processing' Range B3
'
            With Sheets("Outside processing")
                With .Columns("F:F")                                                                        '       Change Column F of 'Outside processing' from text to numbers
                    .NumberFormat = "General"
                    .Value = .Value
                End With
'
                With .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders                       '       Set borders for range B3:K10
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
'
                With .Range("K3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders(xlEdgeLeft)           '       Set thick borders for range K3:K10 (left edge)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                End With
'
                With .Range("K3:K" & .Range("B" & .Rows.Count).End(xlUp).Row).Borders(xlEdgeRight)          '       Set thick borders for range K3:K10 (right edge)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                End With
'
                With .Range("B3:K" & .Range("B" & .Rows.Count).End(xlUp).Row)                               '       Set double borders for the outside edges of range B3:K10
                    .Borders(xlEdgeLeft).LineStyle = xlDouble
                    .Borders(xlEdgeTop).LineStyle = xlDouble
                    .Borders(xlEdgeRight).LineStyle = xlDouble
                    .Borders(xlEdgeBottom).LineStyle = xlDouble
                End With
            End With
        End If
'
        .UsedRange.AutoFilter                                                                               '   Remove the AutoFilter from 'Routing'
'
        With .Columns("E:E")                                                                                '   Return Column F of 'Routing' back from text to numbers
            .NumberFormat = "General"
            .Value = .Value
        End With
    End With
End Sub

**skhande2** · 06-29-2023, 01:48 PM

I'm not sure what you mean. I've attached pictures that match up on both sheets columns E,F & G. When I executed your new macro, instead of running 0 results, it returns results it wasn't supposed to. (see the bottom sheet in both pics)
Attachment 834768
Attachment 834769

From the original post, the criteria was, "I need a macro that filters sheet 'Routing' by column E that starts with digit 6. It then filters column F by those that either start with a space. (or ones that don't start with number - your choice)"

As you can see in the pics, there are no cells in columns E that start with 6

**johnnyL** · 06-29-2023, 01:49 PM

I just edited my previous post.

**johnnyL** · 06-29-2023, 02:03 PM

I also just added an autofilter check to make sure we start with all autofilters removed.

**skhande2** · 06-29-2023, 02:29 PM

That works

. Thanks!

**johnnyL** · 06-29-2023, 02:35 PM

Glad we could help.

**skhande2** · 06-29-2023, 03:09 PM

So..I'm having another issue. Not sure if you will experience it on your end but your macro works flawlessly when only 1 excel sheet is open. But when I've multiple excel sheets open, I get a dialog box, "There is already data here. Do you want to replace it?" Then, I notice nothing is copied over to Outside processing but its emptied out and multiple columns of routing (F,G and H) are wiped out.

**johnnyL** · 06-29-2023, 03:24 PM

I only see one potential issue in the code I submitted:

Change the second line of code from:

        .Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True '   Temporarily convert Column E on 'Routing' to text values

to:

        .Columns("E:E").TextToColumns Destination:=.Range("E1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True '   Temporarily convert Column E on 'Routing' to text values

Try that and see if it resolves the issue. If it doesn't can you further explain the issue you are having? You mentioned 'excel sheet', did you mean ' excel workbooks'?

**skhande2** · 06-29-2023, 05:01 PM

I meant workbooks, yes. Its not happening right now, when it happens again, I will test your correction.

**ORoos** · 06-29-2023, 07:30 PM

Adding my version back into the mix.
The updated macro will exit when no data gas been found to be copied.
The text2column bits will only convert and change back to data at the top, no longer the full column.

Let us know if that works.

Sub FilterData()

Dim lRow, lRowFiltered As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

    lRowFiltered = Cells(Rows.Count, 1).End(xlUp).Row
        If lRowFiltered < 2 Then
        MsgBox "No data found to be copied", vbExclamation, "Data Empty"
        Exit Sub
    End If

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy

    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
On Error GoTo 0
' Reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
   
   
Sheet6.Select
' Reverse column F back from 'Text' to 'General'
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
        
        
    Dim pastedRange As Range
    Dim lRow2 As Long
    
    lRow2 = Cells(Rows.Count, 2).End(xlUp).Row  ' Find last used row in column B (A has formulas)
    
    Call ResetBorders  ' Reset borders before applying double ines to pasted range
    
    Set pastedRange = Sheet6.Range("B3:K" & lRow2) ' Will automatically update to pasted range
    
    ' Apply double lined border to the outer edges of the range
    With pastedRange
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlDouble
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
        
Application.ScreenUpdating = True

End Sub


Sub ResetBorders()

' Set all internal lines to 'Thin - single line'
    Range("B3:K13").Borders.LineStyle = Excel.XlLineStyle.xlContinuous
    
' Add 'thick' outside boarder for column K
    Range("K2:K13").Select
    
    With Selection
        .Borders(xlEdgeTop).LineStyle = xlSingle
        .Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Borders(xlEdgeTop).Weight = xlThick
        
        .Borders(xlEdgeBottom).LineStyle = xlSingle
        .Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Borders(xlEdgeBottom).Weight = xlThick
        
        .Borders(xlEdgeLeft).LineStyle = xlSingle
        .Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Borders(xlEdgeLeft).Weight = xlThick
        
        .Borders(xlEdgeRight).LineStyle = xlSingle
        .Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Borders(xlEdgeRight).Weight = xlThick
    End With
    
End Sub

**skhande2** · 07-03-2023, 10:27 AM

When I run this macro ORoos in a sheet where nothing gets copied, it converts numbers in column E in sheet 'Routing' into text. Could you have it convert back at the end? Thanks

**ORoos** · 07-04-2023, 11:20 PM

Try the code below and let us know if that works for you:

Option Explicit
Dim lRow As Long

Sub FilterData()

Dim lRowFiltered As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

' Check if result is at least one record. If not reverse Text2Column and exit
    lRowFiltered = Cells(Rows.Count, 1).End(xlUp).Row
        If lRowFiltered < 2 Then
            Call ReverseFormating
            MsgBox "No data found to be copied.", vbExclamation, "Data Empty"
        Exit Sub
    End If

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy

    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
On Error GoTo 0

' Reverse column E back from 'Text' to 'General'
    Call ReverseFormating
    
Sheet6.Select
' Reverse column F back from 'Text' to 'General'
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
        
    Dim pastedRange As Range
    Dim lRow2 As Long
    
    lRow2 = Cells(Rows.Count, 2).End(xlUp).Row  ' Find last used row in column B (A has formulas)

' Set all internal lines to 'Thin - single line'
    Range("B3:K13").Borders.LineStyle = Excel.XlLineStyle.xlContinuous
    
' Add 'thick' outside border for column K
     With Sheet6.Range("K2:K13")
        .Borders(xlEdgeLeft).LineStyle = xlSingle
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeTop).LineStyle = xlSingle
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlSingle
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlSingle
        .Borders(xlEdgeBottom).Weight = xlThick
    End With
    
      With Sheet6.Range("B2:K" & lRow2)
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    
                
End Sub
Sub ReverseFormating()

' Reverse column E back from 'Text' to 'General'
Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter

End Sub

**skhande2** · 07-05-2023, 05:27 PM

That worked. Thanks! Hey, could you guys also please take a look at this post? Thanks!
https://www.excelforum.com/excel-pro...ml#post5845536

Appreciated!

**skhande2** · 07-05-2023, 06:08 PM

Actually, its erroring again when I'm combining it with the bulk of other macros, could you write this macro in a way so it doesn't call another routine? I think calling it is making it error. So just 1 Sub and end sub.

**ORoos** · 07-05-2023, 08:52 PM

Try:

Option Explicit

Sub FilterData()

Dim lRow, lRowFiltered As Long

Application.ScreenUpdating = False

    Sheet6.Range("B3:K13").ClearContents   ' clearing old values
    
' Reset AutoFilter to get last row with data
Sheet7.Select
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
  
lRow = Cells(Rows.Count, 1).End(xlUp).Row

' Reset AutoFilters (incl new helper column
  ActiveSheet.Range("A1").AutoFilter
  
' Change Column E Numbers to Text for filtering with wildcard
    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
' Apply filters for columns 'E' & 'F'
    With ActiveSheet.Cells(1, 1).CurrentRegion
        .AutoFilter Field:=5, Criteria1:="=6*", Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="=*", Operator:=xlFilterValues
    End With

' Check if result is at least one record. If not reverse Text2Column and exit
    lRowFiltered = Cells(Rows.Count, 1).End(xlUp).Row
        If lRowFiltered < 2 Then

            ActiveSheet.AutoFilterMode = False
            Range("E2:E" & lRow).Select
            Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 1), TrailingMinusNumbers:=True
            Selection.NumberFormat = "General"
            ActiveSheet.Range("A1").AutoFilter
            MsgBox "No data found to be copied.", vbExclamation, "Data Empty"
        Exit Sub
    End If

    Range("A2:J" & lRow).SpecialCells(xlCellTypeVisible).Copy

    Sheet6.Select

    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
On Error GoTo 0

' Reverse column E back from 'Text' to 'General'
    Sheet7.Select
    ActiveSheet.AutoFilterMode = False

    Range("E2:E" & lRow).Select
    Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    ActiveSheet.Range("A1").AutoFilter
    
Sheet6.Select
' Reverse column F back from 'Text' to 'General'
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
        
    Dim pastedRange As Range
    Dim lRow2 As Long
    
    lRow2 = Cells(Rows.Count, 2).End(xlUp).Row  ' Find last used row in column B (A has formulas)

' Set all internal lines to 'Thin - single line'
    Range("B3:K13").Borders.LineStyle = Excel.XlLineStyle.xlContinuous
    
' Add 'thick' outside border for column K
     With Sheet6.Range("K2:K13")
        .Borders(xlEdgeLeft).LineStyle = xlSingle
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeTop).LineStyle = xlSingle
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlSingle
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlSingle
        .Borders(xlEdgeBottom).Weight = xlThick
    End With
' Add double borders around copied range
      With Sheet6.Range("B2:K" & lRow2)
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeTop).LineStyle = xlDouble
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    
End Sub

Hybrid View

Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Re: Need a macro for filtering and pasting data

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Filtering data then copy pasting to a new workbook

Bookmarks

Bookmarks

Posting Permissions