Need to make two seperate columns with data from one column depending less than or greater than valu-CodePudding

Want to be able to click a button on excel that will run a macro that will delete prior sheet named DATA and allow importing an existing sheet from different workbook on to active workbook. There is a slight pop up of the other workbook which I'm not sure how to not allow it to show up. Then I want Data worksheet to be after Dashboard worksheet. From there I want a specific column from that data, Total, to only show values greater than 1. Finally split those values from total to two sperate columns, B and P. B will have values 28 and higher while P will have values of equal to 28 or less than. Here is what I have so far. Thank you!

Edit: I went ahead and modified. I have left it at once DATA sheet has been imported. I would like it to filter the following numerical values from the column that is named Total and only show values greater than 1. After that's been filtered, create two columns right next to "Total" named "p" and "b". The values from DATA column greater than 28 will be in "b" while less or equal to 28 will be in "p". Thank you so much!

Option Explicit

Sub DATA()

Dim ws As Worksheet     'Dim, dimension. Declare variable to be used later

On Error Resume Next    'Continues executing statement, ignores error
Application.DisplayAlerts = False 'Set to false to suppres prompts
Sheets("DATA").Delete
Application.DisplayAlerts = True
On Error GoTo 0         'Disables any error trapping currently present in the procedure

Dim fName As Variant, wb As Workbook 'Variant data type can be used to define variables that contain any type of data


Application.EnableEvents = False 'Disable events to avoid workbooks_open to be started

fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*") 'fname, file with excel file ext

On Error Resume Next    'Continues executing statement, ignores error
If fName = False Then   'False, exit, msg will show
    MsgBox ("No Data selected!")
    Exit Sub
End If
On Error GoTo 0

Set wb = Workbooks.Open(fName)
wb.Sheets(1).Copy before:=ThisWorkbook.Sheets(2) 'Importing data from first sheet on to this wb, second location
ActiveSheet.Name = "DATA" 'Naming the sheet DATA
wb.Close False            'Close workbook

Application.EnableEvents = True



Dim SelRange As Range
Dim ColNum As Integer
   
ColNum = Application.WorksheetFunction.Match("Total ", 0)

    ActiveSheet.AutoFilter Field:=16, Criteria1:=">1", _
    Operator:=xlAnd

CodePudding user response：

Either you have more then one sheets in the workbook you open.
Then you need to number your "DATA" sheets => DATA_01, DATA_02, ...

Or you have only one DATA Sheet. Then there is no need to loop!
Your B and P, <28 and >28 is not clear. I have realized two variants to filter and copy which should help you to realize your solution.

Option Explicit

Sub DATA()

    'Clicking button will delete worksheet DATA prior to adding a new one
    Dim ws As Worksheet

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
 
    Dim fName As Variant, wb As Workbook
    
    'Disable events to avoid workbooks_open to be started
    Application.EnableEvents = False
    
    'This will allow screen to pop up and choose file
    
    fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
    
    On Error Resume Next
    If fName = False Then
        MsgBox ("No workbook selected!")
        Exit Sub
    End If
    On Error GoTo 0

    Set wb = Workbooks.Open(fName)
    wb.Sheets(1).Copy before:=ThisWorkbook.Sheets(3)
    ActiveSheet.Name = "DATA"
    wb.Close False
    
    Application.EnableEvents = True

    'Where do you want to copy the values to?
    'New sheet "COPY"?
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("COPY").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    'Worksheets.Add(before:=Sheets(4)).Name = "COPY"
    '
    '??? Finally split those values from total to two sperate columns, B and P.
    '??? B will have values 28 and higher while P will have values of equal to 28 or less than.
    
    '??? value 28 shall be in both groups?
    
    'Define Criterias: Title   Condition
    With Sheets("DATA")
        .Range("F1").Value = "Value" 'Range("P1").Value
        .Range("F2").Value = ">1"
        .Range("G1").Value = "Value" 'Range("P1").Value
        .Range("G2").Value = "<29"
    End With
    
    Sheets("DATA").Range("H:Z").Delete
    
    Sheets("DATA").Range("I1").Value = "values >1 and <29"
    Sheets("Data").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("DATA").Range("F1:G2"), _
        CopyToRange:=Sheets("DATA").Range("I2"), _
        Unique:=True
    
    'Define Criterias: Title   Condition
    Sheets("DATA").Range("F4").Value = "Value" 'Range("P1").Value
    Sheets("DATA").Range("F5").Value = ">28"
    
    Sheets("DATA").Range("N1").Value = "values >28"
    Sheets("Data").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("DATA").Range("F4:F5"), _
        CopyToRange:=Sheets("DATA").Range("N2"), _
        Unique:=True
    
End Sub

CodePudding user response：

Solve your task with a formula:

You could add a formula for column "p" and "b"? Of cause you can add this formula also with vba.

Formulara in "p"
=IF(B6<=28,B6,"") or =IF([@Total]<=28,[@Total],"")

Formula in "b"
=IF(B12>28,B12,"") or =IF([@Total]>28,[@Total],"")