extracting non-date/time text from column into a new sheet

时间:2016-03-04 18:11:19

标签: excel excel-vba date time vba

I have a workbook with data that is organized in two columns. The first column of the data is in the following format:

Medication Flush    

3/1/2014 1:00 PST

Feeding Amount Infant

Feeding Amount Infant (PG EBM)  

3/5/2014 8:00 PST

Feeding Amount Infant (PG EBM SimHMF 1pk/25)

3/4/2014 23:03 PST

3/4/2014 20:07 PST
...
etc

From this first column, I would like to extract content that are not dates (ex. "Feeding Amount", "Feeding Amount Infants (PG EBM)",...). And copy these values onto a different workbook. I don't want the new column to have repeating content. For example ("Feeding Amount", "Feeding Amount"... )... but I want to include it if the content is not exactly the same. For example ("Feeding amount", "Feeding Amount Infants (PG EMB)")

To do this, I tried to run the following code:

Sub feedingtypeslist()

'Declare variables
Dim wbfeedingdata As Workbook
Dim wbfeedingtype As Workbook
Dim feedingtypes() As String
Dim lrowtypes As Integer
Dim uprbnd As Integer

'declare raw data workbook
Set wbfeedingdata = Workbooks.Open("C:\Users\Devang\Desktop\NIRS US\CleanOrig\feeding\feeding data.xlsx")

'number of rows in raw dataset
lrowtypes = Cells(Rows.Count, 1).End(xlUp).Row

ReDim feedingtypes(1)
'Search dataset, find cells that don't have a date/time value, check if the text does not already exist in the array, resize the array, and add text from this cell to the array
For i = 1 To lrowtypes
        uprbnd = UBound(feedingtypes)
        If IsDate("" & Cells(i, 1).Text & "") = False And IsInArray((Cells(i, 1).Text), feedingtypes, uprbnd) = False Then
             'resize array to prepare for add value
            ReDim Preserve feedingtypes(uprbnd + 1)
            'add value to array list
            feedingtypes(UBound(feedingtypes)) = Cells(i, 1).Value
        End If
Next i

'declare print workbook
Set wbfeedingtype = Workbooks.Open("C:\Users\Devang\Desktop\NIRS US\CleanOrig\feeding\feeding types.xlsx")

'print array onto cells
For x = 1 To UBound(feedingtypes)
    Cells(x, 1).Value = feedingtypes(x)
Next x

End Sub

'this function checks if an inputed string of text already exists in an array

Function IsInArray(ThsStrng As String, arr() As String, bnd As Integer) As Boolean
    For Z = 1 To bnd
        If arr(Z) = ThsStng Then
            IsInArray = True
        Else
            IsInArray = False
        End If
    Next Z
End Function

The code runs without error, however, the new workbook does have any data... it is blank.

0 个答案:

没有答案