Hello
I'm a newbie when it comes to VBA programming but I managed to find bits of code that I've merged together in a script based on info I found from different sources online. I just need a little help tweaking the code so it works for my purposes. Here's what I'd like to accomplish:
- Run macro when Excel file is opened
- Search inside a specific folder for all text files
- Copy all data from text files into same worksheet
- Remove duplicate rows that occur from scanning text files multiple times
Here is the code I have found so far, but it needs some tweaking:
Sub copy_txt_files()
Dim FSO As Object, Folder As Object, file As Object
Dim copyFrom As Workbook
Dim wksCopyTo As Worksheet, wksCopyFrom As Worksheet
Dim rngCopyTo As Range, rngCopyFrom As Range
Set wksCopyTo = ThisWorkbook.Sheets(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\temp")
For Each file In Folder.Files
If LCase(Right(file.Name, 4)) = ".txt" Then
Set copyFrom = Workbooks.Open("C:\temp\" & file.Name)
Set wksCopyFrom = copyFrom.Sheets(1)
Set rngCopyFrom = wksCopyFrom.Range("a1")
Set rngCopyFrom = wksCopyFrom.Range(rngCopyFrom, _
rngCopyFrom.SpecialCells(xlCellTypeLastCell))
Set rngCopyTo = wksCopyTo.Range("a1").SpecialCells(xlCellTypeLastCell)
If rngCopyTo.Address <> wksCopyTo.Range("a1").Address Then
Set rngCopyTo = wksCopyTo.Cells(rngCopyTo.Row + 1, 1)
End If
rngCopyFrom.Copy
wksCopyTo.Paste rngCopyTo
Application.CutCopyMode = False
copyFrom.Close False
End If
Next file
End Sub
Sub deleteDuplicate(WSName As String)
Dim cRow As Integer
Dim cRow2 As Integer
Dim cCol As Integer
Dim foundDuplicate As Boolean
cRow = 2
Do While IsEmpty(Worksheets(WSName).Cells(cRow, 1)) = False
cRow2 = cRow + 1
Do While IsEmpty(Worksheets(WSName).Cells(cRow2, 1)) = False
foundDuplicate = True
For cCol = 1 To 7
If Worksheets(WSName).Cells(cRow, cCol).Value <> Worksheets(WSName).Cells(cRow2, cCol).Value Then
foundDuplicate = False
Exit For
End If
Next
If foundDuplicate = True Then
Worksheets(WSName).Rows(cRow2).Delete xlShiftUp
Else
cRow2 = cRow2 + 1
End If
Loop
cRow = cRow + 1
Loop
End Sub
Sub test()
deleteDuplicate "Sheet1"
End Sub
Any help/guidance is greatly appreciated!
Thank you,
Anthony
Bookmarks