Forum Discussion

dhan09's avatar
dhan09
Copper Contributor
Nov 04, 2020
Solved

VBA copy specific criteria

I have a workbook with 4 sheets: first one is the raw data sheet, then 3 target sheets. I would need a macro that would look at cell C in raw data sheet and based on the criteria values between 1 ...
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Nov 04, 2020

    dhan09 

    Try this as starting point. You may have to change it since your macro and description don't match.

    Sub SplitData()
    Dim wshS As Worksheet
    Dim strCol As String
    Dim rng As Range
    Application.ScreenUpdating = False
    Set wshS = Worksheets("Main Menu")
    strCol = "C"
    Set rng = wshS.Range("A1").CurrentRegion
    rng.AutoFilter Field:=3, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=30"
    rng.Copy Destination:=Worksheets("0-30 Days").Range("A1")
     rng.AutoFilter Field:=3, Criteria1:=">=31", _
        Operator:=xlAnd, Criteria2:="<=60"
    rng.Copy Destination:=Worksheets("31-60 Days").Range("A1")
    rng.AutoFilter Field:=3, Criteria1:=">=61", _
        Operator:=xlAnd, Criteria2:="<=90"
    rng.Copy Destination:=Worksheets("61-90 Days").Range("A1")
    rng.AutoFilter
   Application.ScreenUpdating = True
End Sub
HansVogelaar's avatar
HansVogelaar
MVP
Nov 04, 2020

dhan09 

Try this as starting point. You may have to change it since your macro and description don't match.

Sub SplitData()
    Dim wshS As Worksheet
    Dim strCol As String
    Dim rng As Range
    Application.ScreenUpdating = False
    Set wshS = Worksheets("Main Menu")
    strCol = "C"
    Set rng = wshS.Range("A1").CurrentRegion
    rng.AutoFilter Field:=3, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=30"
    rng.Copy Destination:=Worksheets("0-30 Days").Range("A1")
     rng.AutoFilter Field:=3, Criteria1:=">=31", _
        Operator:=xlAnd, Criteria2:="<=60"
    rng.Copy Destination:=Worksheets("31-60 Days").Range("A1")
    rng.AutoFilter Field:=3, Criteria1:=">=61", _
        Operator:=xlAnd, Criteria2:="<=90"
    rng.Copy Destination:=Worksheets("61-90 Days").Range("A1")
    rng.AutoFilter
   Application.ScreenUpdating = True
End Sub
  • dhan09's avatar
    dhan09
    Copper Contributor
    Nov 04, 2020

    HansVogelaarThanks for valuable input,  I'm trying add  below code for more than 91 days and I'm getting error 'Run time Error 9 : Subscript out of range"
     rng.AutoFilter Field:=3, Criteria1:=">=91", _
    rng.Copy Destination:=Worksheets("91+ Days").Range("B7")
    rng.AutoFilter

     

     

     

     

     

    Sub SplitData()
    Dim wshS As Worksheet
    Dim strCol As String
    Dim rng As Range
    Application.ScreenUpdating = False
    Set wshS = Worksheets("Main Menu")
    strCol = "C"
    Set rng = wshS.Range("A1").CurrentRegion
    rng.AutoFilter Field:=3, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=30"
    rng.Copy Destination:=Worksheets("0-30 Days").Range("A1")
     rng.AutoFilter Field:=3, Criteria1:=">=31", _
        Operator:=xlAnd, Criteria2:="<=60"
    rng.Copy Destination:=Worksheets("31-60 Days").Range("A1")
    rng.AutoFilter Field:=3, Criteria1:=">=61", _
        Operator:=xlAnd, Criteria2:="<=90"
    rng.Copy Destination:=Worksheets("61-90 Days").Range("A1")
     
    rng.AutoFilter Field:=3, Criteria1:=">=91", _
      rng.Copy Destination:=Worksheets("91+ Days").Range("B7")
rng.AutoFilter
   Application.ScreenUpdating = True
End Sub

     

     

     

     

      

    • HansVogelaar's avatar
      HansVogelaar
      MVP
      Nov 04, 2020

      dhan09 

      You forgot to copy a line:

      Sub SplitData()
    Dim wshS As Worksheet
    Dim strCol As String
    Dim rng As Range
    Application.ScreenUpdating = False
    Set wshS = Worksheets("Main Menu")
    strCol = "C"
    Set rng = wshS.Range("A1").CurrentRegion
    rng.AutoFilter Field:=3, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=30"
    rng.Copy Destination:=Worksheets("0-30 Days").Range("B7")
    rng.AutoFilter Field:=3, Criteria1:=">=31", _
        Operator:=xlAnd, Criteria2:="<=60"
    rng.Copy Destination:=Worksheets("31-60 Days").Range("B7")
    rng.AutoFilter Field:=3, Criteria1:=">=61", _
        Operator:=xlAnd, Criteria2:="<=90"
    rng.Copy Destination:=Worksheets("61-90 Days").Range("B7")
    rng.AutoFilter Field:=3, Criteria1:=">=91", _
        Operator:=xlAnd, Criteria2:="<=90"
    rng.Copy Destination:=Worksheets("91+ Days").Range("B7")
    rng.AutoFilter
    Application.ScreenUpdating = True
End Sub

Resources