etract unique data from multiple workbooks after extracting data

[kkirank.kmp]

hi,
I have a some of workbooks in a folder, which I created using a
macro (from text files). The coulmns and data types are the same
across these workbooks. Column C has a 15 digit number, I need to
extract the first 2 digits from the column and insert it in another
column (new column). Once this is done on all the workbooks I need to
extract unique data from all the workbooks and paste it in the current
workbook from which I'm running the macro. I need to get this done
through a macro as I connot combine the data (their are more than 100K
of rows in all the files). For example
Workbook1
Column C Extracted data
123456789012345 12
234567890112345 23
123456789012345 12
321456712389034 32
342445432321321 34

Workbook2
Column C Extracted data
123456789012345 12
134567890112345 13
143456789012345 14
321456712389034 32
342445432321321 34

From the above 2 workbooks I need to get the unique values, so it
would be 12, 13,14,23,32,34.

Could anyone please help me with this. Thanks in advance for any help.

 

[Joel]

Try this code

Sub GetData()

Const Folder = "c:\temp\working"

With ThisWorkbook.ActiveSheet
If .Range("C1") = "" Then
NewRow = 1
Else
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End If
End With
First = True
Do
If First = True Then
Filename = Dir(Folder & "\*.xls")
First = False
Else
Filename = Dir()
End If

If Filename <> "" Then
Workbooks.Open Filename:=Folder & _
"\" & Filename
With ActiveWorkbook.ActiveSheet

RowCount = 1
Do While .Range("C" & RowCount) <> ""
ExtractData = Left(.Range("C" & RowCount), 2)
.Range("D" & RowCount) = ExtractData

With ThisWorkbook.ActiveSheet
Set c = .Columns("C:C").Find( _
what:=ExtractData, _
LookIn:=xlValues)
If c Is Nothing Then
.Range("C" & NewRow) = ExtractData
NewRow = NewRow + 1
End If
End With
RowCount = RowCount + 1
Loop
ActiveWorkbook.Close SaveChanges:=True
End With
End If
Loop While Filename <> ""

End Sub

 

[kkirank.kmp]

Thank you so much..... it worked..... I modified it a little bit.
Thanks again

 

[steve.auyong]

Try this code

Sub GetData()

Const Folder = "c:\temp\working"

With ThisWorkbook.ActiveSheet
   If .Range("C1") = "" Then
      NewRow = 1
   Else
      LastRow = .Range("C" & Rows.Count).End(xlUp).Row
      NewRow = LastRow + 1
   End If
End With
First = True
Do
   If First = True Then
      Filename = Dir(Folder & "\*.xls")
      First = False
   Else
      Filename = Dir()
   End If

   If Filename <> "" Then
      Workbooks.Open Filename:=Folder & _
         "\" & Filename
      With ActiveWorkbook.ActiveSheet

         RowCount = 1
         Do While .Range("C" & RowCount) <> ""
            ExtractData = Left(.Range("C" & RowCount), 2)
            .Range("D" & RowCount) = ExtractData

            With ThisWorkbook.ActiveSheet
               Set c = .Columns("C:C").Find( _
                  what:=ExtractData, _
                  LookIn:=xlValues)
               If c Is Nothing Then
                  .Range("C" & NewRow) = ExtractData
                  NewRow = NewRow + 1
               End If
            End With
            RowCount = RowCount + 1
         Loop
         ActiveWorkbook.Close SaveChanges:=True
      End With
   End If
Loop While Filename <> ""

End Sub








- Show quoted text -

hi

I need you guys help. how do I return a column of Fruits to a row with
Unique Fruit using excel formula. Example below



Apple Orange Pear Strawberry
Apple
Apple
Apple
Orange
Orange
Pear
Orange
Pear
Strawberry