reformat data if column criteria is meet

**cmccabe** · 12-31-2014, 12:25 PM

I am trying to create a button that will clear and reformat the input data based on criteria ("array") being meet in a column [Test]. I hope the below VB is close:

 Private Sub Workbook_Open()
Dim sR As String
Dim sFile As String
    Sheets("Input").Activate
    Range("A1").Select
    sR = MsgBox("Clear the input sheet for new data?", vbQuestion + vbYesNo + vbDefaultButton2)
    If sR = vbYes Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Input").UsedRange.Clear
        ChDrive "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        ChDir "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        On Error GoTo 0
        sFile = Application.GetOpenFilename _
            (FileFilter:="Excel Workbooks, *.xlsx", MultiSelect:=False)
        Workbooks.OpenText Filename:=sFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), _
            Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
            Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _
            29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
            Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array( _
            42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
            Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array( _
            55, 1)), TrailingMinusNumbers:=True
        ActiveWorkbook.Sheets(1).UsedRange.Copy
        ThisWorkbook.Sheets("Input").Range("A1").PasteSpecial
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Sheets("Input").Activate
        ActiveSheet.Range("A1").Select
        Application.ScreenUpdating = True
    End If
End Sub

' reformat the input
If [Test]=”array”, Then [Lab #], [Name], [Result], [Final]

Thank you

.

**cmccabe** · 12-31-2014, 12:29 PM

Not sure why this posted twice, but there is an example attached in the other post. Thank you and I apologize for the duplicate

.

**Richard Buttrey** · 12-31-2014, 12:36 PM

That macro is in the Workbook Open event. If you want it attached to a button then create a Module level procedure and point the button to that procedure.

You'll need to change the PasteSpecial line to

ThisWorkbook.Sheets("Input").Range("A1").PasteSpecial(xlPasteValues)

**cmccabe** · 12-31-2014, 12:51 PM

So I create a button with:

 ' reformat the input
If [Test]=”array”, Then [Lab #], [Name], [Result], [Final]

and then a module with:

 Private Sub Workbook_Open()
Dim sR As String
Dim sFile As String
    Sheets("Input").Activate
    Range("A1").Select
    sR = MsgBox("Clear the input sheet for new data?", vbQuestion + vbYesNo + vbDefaultButton2)
    If sR = vbYes Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Input").UsedRange.Clear
        ChDrive "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        ChDir "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        On Error GoTo 0
        sFile = Application.GetOpenFilename _
            (FileFilter:="Excel Workbooks, *.xlsx", MultiSelect:=False)
        Workbooks.OpenText Filename:=sFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), _
            Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
            Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _
            29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
            Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array( _
            42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
            Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array( _
            55, 1)), TrailingMinusNumbers:=True
        ActiveWorkbook.Sheets(1).UsedRange.Copy
        ThisWorkbook.Sheets("Input").Range("A1"). PasteSpecial(xlPasteValues)
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Sheets("Input").Activate
        ActiveSheet.Range("A1").Select
        Application.ScreenUpdating = True
    End If
End Sub

Thank you

.

**Richard Buttrey** · 12-31-2014, 01:06 PM

Not necessarily.

You mentioned a button so I took you at your word and assumed you wanted to control this process without it running automatically when the workbook opens.

I'm not exactly sure what the IF [Test] stuff is, but f you want the process to run automatically then a button is, strictly speaking, not necessary since you could put everything in the Workbook open event. i.e.

' reformat the input
If [Test]=”array”, Then 
   [Lab #], [Name], [Result], [Final]
   'the rest of your code
   Else
   Exit Sub
End If

Otherwise a button which points to a procedure with your IF [Test] stuff and which ends with a line

Call MyNewDataProcedure 'where 'MyNewDataProcedure' is a module level procedure that contains your code

**cmccabe** · 12-31-2014, 01:26 PM

I placed a button in the spreadsheet:

 Private Sub CommandButton1_Click()
' reformat the input
If [Test]=”array”, Then
   [Lab #] , [Name], [Result], [Final]
   Else
   Exit Sub
End If
End Sub

and a workbook open event in the spreadsheet.

When the code is run I get: syntax error

the

 If [Test]=”array”, Then

is highlighted. Thank you

.

**Richard Buttrey** · 12-31-2014, 01:41 PM

...As I said I don't understand what your If [Test] "array" string of characters is trying to do. This didn't enter the thread until post #4 and I assumed this was code that was working for you already.

Please explain by a narrative what you are trying to achieve with this.

**cmccabe** · 12-31-2014, 02:17 PM

In the attached workbook there is a column [Test] that has multiple values in it. If the value in the column is "array" then [Lab #] , [Name], [Result], [Final] are copied to the input sheet. If the value is anything else it is removed. Thank you

.

**Richard Buttrey** · 12-31-2014, 02:46 PM

I'm confused.

the original task seemed to be to open a file and copy the contents to the input sheet. You're last note seems to be saying that you are also copying some of the rows on the Input sheet but to where? The input sheet?
And in which case to where is the data from the file you open copied?

**cmccabe** · 12-31-2014, 02:50 PM

When the spreadsheet is first opened the user is prompted for new data, then the data is loaded in the input sheet. However only the data that has array in the Test column is needed. The desired columns are kept in the input sheeet all others are removed. I hope this helps and thank you

.

**Richard Buttrey** · 12-31-2014, 05:32 PM

OK understood.

I'm going to assume that your existing file open copy/paste stuff works OK. In which case put the whole of this code either in the Workbook Open event of yuo want it to run automatically when it opens, or in a module level procedure which you can link to a button if you want to control the process pf loading.

Dim sR As String
    Dim sFile As String
    'Sheets("Input").Activate
    'Range("A1").Select
    sR = MsgBox("Clear the input sheet for new data?", vbQuestion + vbYesNo + vbDefaultButton2)
    If sR = vbYes Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Input").UsedRange.Clear
        ChDrive "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        ChDir "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        On Error GoTo 0
        sFile = Application.GetOpenFilename _
                (FileFilter:="Excel Workbooks, *.xlsx", MultiSelect:=False)
        Workbooks.OpenText Filename:=sFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                           FieldInfo:=Array(Array(1, 1), Array(2, 1), _
                                            Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                                            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                                            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
                                            Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), _
                                            Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
                                            Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), _
                                            Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
                                            Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1)), _
                                            TrailingMinusNumbers:=True
        ActiveWorkbook.Sheets(1).UsedRange.Copy
        ThisWorkbook.Sheets(Sheet1.CodeName).Range("A1").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Sheet1.Activate
        Range("A1").Select
        Application.ScreenUpdating = True
        With Sheet1.Range("A1")
            .AutoFilter field:=4, Criteria1:="<>Array"
            .CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter

        End With
        Sheet1.Range("A:A,D:D,F:F,H:H").EntireColumn.Delete
    End If

**cmccabe** · 01-02-2015, 11:37 AM

 Private Sub Workbook_Open()
    Dim sR As String
    Dim sFile As String
    'Sheets("Input").Activate
    'Range("A1").Select
    sR = MsgBox("Clear the input sheet for new data?", vbQuestion + vbYesNo + vbDefaultButton2)
    If sR = vbYes Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Input").UsedRange.Clear
        ChDrive "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        ChDir "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        On Error GoTo 0
        sFile = Application.GetOpenFilename _
                (FileFilter:="Excel Workbooks, *.xlsx", MultiSelect:=False)
        Workbooks.OpenText Filename:=sFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                           FieldInfo:=Array(Array(1, 1), Array(2, 1), _
                                            Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                                            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                                            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
                                            Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), _
                                            Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
                                            Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), _
                                            Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
                                            Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1)), _
                                            TrailingMinusNumbers:=True
        ActiveWorkbook.Sheets(1).UsedRange.Copy
        ThisWorkbook.Sheets(Sheet1.CodeName).Range("A1").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Sheet1.Activate
        Range("A1").Select
        Application.ScreenUpdating = True
        With Sheet1.Range("A1")
            .AutoFilter field:=4, Criteria1:="<>Array"
            .CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter

        End With
        Sheet1.Range("A:A,D:D,F:F,H:H").EntireColumn.Delete
    End If
End Sub

I get subscript out of range with the underlined portion highlighted. The sheet 1 name is Input. Thank you

.

**Richard Buttrey** · 01-02-2015, 11:48 AM

Hi,

Sorry that should be

ThisWorkbook.Sheets(Sheet1.Name).Range("A1").PasteSpecial (xlPasteValues)

Check that the VB code name for your "Input" tab name is indeed 'Sheet1'. If not change Sheet1 to whatever is the VB code name. It's usually better to work with VB code names since these never change. If you hard code the tab name in the code and someone changes the tab name you're stuffed.

**cmccabe** · 01-02-2015, 12:42 PM

That worked.

Column D (Final) is a date and is not displaying as such.
The spreadsheet in which the new data is loaded is multiple tabs (12 total), is there a way to prompt the user for a specific tab in a spreadsheet.

So, there is one spreasheet (Month) in which the data is loaded from, but in that spreadsheet there are 12 tabs. Thank you

.

**Richard Buttrey** · 01-02-2015, 01:24 PM

Hi,

Yes just create an input box asking the user to enter a valid tab name and apply that name to a string variable, say 'stMonth'. You may need to think about validating the text that's entered.

So assuming the input box captures the string "January" and there is a tab of that name adapt the macro so that it says

ActiveWorkbook.Sheets(stMonth).UsedRange.Copy

I'm not sure what you mean by the last column D not displaying correctly. What's in the original file and how is the column in the sheet you're copying formatted?

**cmccabe** · 01-02-2015, 02:55 PM

HTML Code:

The last column is a date that is in date format in the original.

 Private Sub Workbook_Open()
    Dim sR As String
    Dim sFile As String
    Dim sMonth As String
    'Sheets("Input").Activate
    'Range("A1").Select
    sR = MsgBox("Clear the input sheet for new data?", vbQuestion + vbYesNo + vbDefaultButton2)
    If sR = vbYes Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Input").UsedRange.Clear
        sMonth = InputBox("Enter Month:")
        ChDrive "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        ChDir "N:\2_TQM\aCGH QC Data\Array QC\For Bob"
        On Error GoTo 0
                sFile = Application.GetOpenFilename _
                (FileFilter:="Excel Workbooks, *.xlsx", MultiSelect:=False)
        Workbooks.OpenText Filename:=sFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                           FieldInfo:=Array(Array(1, 1), Array(2, 1), _
                                            Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                                            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                                            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
                                            Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), _
                                            Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
                                            Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), _
                                            Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
                                            Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1)), _
                                            TrailingMinusNumbers:=True
        ActiveWorkbook.Sheets(sMonth).UsedRange.Copy
        ThisWorkbook.Sheets(Sheet1.Name).Range("A1").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Sheet1.Activate
        Range("A1").Select
        Application.ScreenUpdating = True
        With Sheet1.Range("A1")
            .AutoFilter field:=4, Criteria1:="<>Array"
            .CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter

        End With
        Sheet1.Range("A:A,D:D,F:F,H:H,I:I").EntireColumn.Delete
    End If
End Sub

The code works great, how would I validate the text entered? I am assuming you mean Jan vs. January (is there code that looks for either). Thank you

.

**Richard Buttrey** · 01-02-2015, 04:12 PM

Hi,

Yes you could check for various spellings or check the entry against an array of valid names. Personally though I'd offer the user a simple form with a drop down combobox that contains all the month names then there's no doubt.

reformat data if column criteria is meet

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Re: reformat data if column criteria is meet

Thread Information

Users Browsing this Thread

Similar Threads

reformat data if column criteria is meet

[SOLVED] Count of rows in an array that meet criteria in column 2 and different criteria in column3

[SOLVED] Count Unique Values in Column A that meet criteria in Column B

Sum certain cells in a column if they meet criteria in seperate column

[SOLVED] Sum the values of one column, only if they meet certain criteria .

Bookmarks

Bookmarks

Posting Permissions