(Hope the formatting is okay. I’m doing this on my phone, so it’s hard to tell.)
So, I’m trying to create some VBA to automate the clean up process of data I get from my field crews. Everything below works perfectly, but I’m trying to add on it to make it where, at the very end, it exports a .txt and saves a macro-enabled workbook of the file to the same path the original files were imported from (\\Atlas\Projects\[fileName]\Survey\In\). The issue is, it hasn’t mattered how I’ve tried to change up the code for exporting and saving, I keep getting “file path doesn’t exist” errors or Object errors. I can’t figure out why and thought maybe someone here could give some insight. Thanks in advance for any suggestions or guidance!
Export/Save Code I’m Trying to Add
Note: When I add it, I’ve tried both leaving the Dims where they are and also tried moving them up with the rest of the Dims in the functioning code.
' Export CleanDataTBL to a comma-delimited .txt fileDim exportFileName As StringDim exportFilePath As StringexportFileName = fileName & "-AllPoint-" & Format(Date, "YYYYMMDD") & "-DeDuped.txt"exportFilePath = "\\Atlas\Projects\" & fileName & "\Survey\In\" & exportFileNametbl.DataBodyRange.CopyWorkbooks.Add(1).Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValuesApplication.DisplayAlerts = FalseActiveWorkbook.SaveAs exportFilePath, FileFormat:=xlText, CreateBackup:=FalseApplication.DisplayAlerts = TrueActiveWorkbook.Close False' Save macro-enabled workbook with the same name format but with "-Workbook" suffixDim workbookFileName As StringDim workbookFilePath As StringworkbookFileName = fileName & "-AllPoint-" & Format(Date, "YYYYMMDD") & "-DeDuped-Workbook.xlsm"workbookFilePath = "\\Atlas\Projects\" & fileName & "\Survey\In\" & workbookFileNameThisWorkbook.SaveAs workbookFilePath, FileFormat:=52 ' xlOpenXMLWorkbookMacroEnabledFunctioning Code I’m Trying to Add TO
Sub RawFDCleanup() Dim RawDataWS As Worksheet Dim fileName As String Dim filePath As String Dim fileContent As String Dim fileLine As Variant Dim lastRow As Long Dim tbl As ListObject Dim rng As Range Dim i As Long Dim j As Long Dim k As Long Dim pointColRaw As Range Dim cellRaw As Range Dim duplicateRaw As Boolean Dim CleanDataWS As Worksheet Dim cleanDataTbl As ListObject Dim rowCount As Long Dim colCount As Long Dim l As Long Dim m As Long Dim deleteRow As Boolean Dim pointColClean As Range Dim cellClean As Range Dim duplicateClean As Boolean' Create RawDataWS worksheet Set RawDataWS = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) RawDataWS.Name = "RawDataWS"' Add headers With RawDataWS .Cells(1, 1).Value = "Point #" .Cells(1, 2).Value = "Northing" .Cells(1, 3).Value = "Easting" .Cells(1, 4).Value = "Elevation" .Cells(1, 5).Value = "Description" End With' Prompt user for file name fileName = InputBox("Enter a job # to search for on \\Atlas\Projects\:")' Construct file path filePath = "\\Atlas\Projects\" & fileName & "\Survey\In\"' Check if directory exists If Dir(filePath, vbDirectory) <> "" Then' Loop through all .txt files in the directory fileName = Dir(filePath & "*.txt")' Initialize lastRow to the first available row lastRow = 2 ' Start from row 2 to skip headers Do While fileName <> ""' Open file and read content Open filePath & fileName For Input As #1 Do Until EOF(1) Line Input #1, fileLine fileContent = fileContent & fileLine & vbCrLf Loop Close #1' Split content by newline and paste into worksheet Dim lines() As String lines = Split(fileContent, vbCrLf) For i = 0 To UBound(lines) Dim rowData() As String rowData = Split(lines(i), ",")' Convert text-formatted values to numbers RawDataWS.Cells(lastRow, 1).Resize(1, 5).Value = rowData' Convert text to numbers in the Point #, Northing, Easting, and Elevation columns RawDataWS.Cells(lastRow, 1).Resize(1, 4).Value = RawDataWS.Cells(lastRow, 1).Resize(1, 4).Value lastRow = lastRow + 1 Next i' Reset file content for next file fileContent = ""' Move to the next file fileName = Dir Loop Else MsgBox "Directory not found." End If' After importing all data, format as a table If lastRow > 2 Then' Convert the data to a table Set tbl = RawDataWS.ListObjects.Add(xlSrcRange, RawDataWS.Range("A1").Resize(lastRow - 1, 5), , xlYes) tbl.Name = "RawDataTBL" tbl.TableStyle = "TableStyleMedium4"' Format Northing, Easting, and Elevation columns to three decimal places With tbl.ListColumns("Northing").DataBodyRange .NumberFormat = "0.000" End With With tbl.ListColumns("Easting").DataBodyRange .NumberFormat = "0.000" End With With tbl.ListColumns("Elevation").DataBodyRange .NumberFormat = "0.000" End With' Set the width of columns A to D to specified values RawDataWS.Columns("A").ColumnWidth = 8 RawDataWS.Columns("B:C").ColumnWidth = 14 RawDataWS.Columns("D").ColumnWidth = 10' Autofit column E to the width of its content RawDataWS.Columns("E").AutoFit' Align text of Columns B-D to center RawDataWS.Columns("B:D").HorizontalAlignment = xlCenter' Turn off filter button tbl.ShowAutoFilter = False' Remove blank rows from the table Set rng = tbl.DataBodyRange For i = rng.Rows.Count To 1 Step -1 If Application.WorksheetFunction.CountA(rng.Rows(i)) = 0 Then rng.Rows(i).Delete End If Next i End If' Check for duplicates in RawDataTBL Set RawDataWS = ThisWorkbook.Worksheets("RawDataWS") Set tbl = RawDataWS.ListObjects("RawDataTBL") Set pointColRaw = tbl.ListColumns("Point #").DataBodyRange For Each cellRaw In pointColRaw If WorksheetFunction.CountIf(pointColRaw, cellRaw.Value) > 1 Then If WorksheetFunction.CountIf(tbl.ListColumns("Point #").DataBodyRange, cellRaw.Value) = 1 Then tbl.Range.Rows(cellRaw.Row).Delete Else tbl.Range.Rows(cellRaw.Row).Interior.Color = RGB(255, 192, 192) tbl.Range.Rows(cellRaw.Row).Font.Color = RGB(192, 0, 0) End If duplicateRaw = True End If Next cellRaw If Not duplicateRaw Then MsgBox "No duplicate Point #’s were found in the field data.", vbInformation End If' Duplicate RawDataWS worksheet RawDataWS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)' Rename the duplicated worksheet ActiveSheet.Name = "CleanDataWS"' Explicitly set CleanDataWS worksheet Set CleanDataWS = ThisWorkbook.Worksheets("CleanDataWS")' Rename the table on CleanDataWS worksheet On Error Resume Next Set cleanDataTbl = CleanDataWS.ListObjects("RawDataTBL3") On Error GoTo 0 If Not cleanDataTbl Is Nothing Then cleanDataTbl.Name = "CleanDataTBL" Else MsgBox "No table found on CleanDataWS worksheet.", vbExclamation End If' Change table style of CleanDataTBL If Not cleanDataTbl Is Nothing Then cleanDataTbl.TableStyle = "TableStyleMedium3" Else MsgBox "No table found on CleanDataWS worksheet.", vbExclamation End If' Analyze and remove duplicate rows in CleanDataTBL If Not cleanDataTbl Is Nothing Then rowCount = cleanDataTbl.ListRows.Count colCount = cleanDataTbl.ListColumns.Count' Iterate through each row For l = rowCount To 2 Step -1 deleteRow = False' Iterate through each previous row to compare For m = l - 1 To 1 Step -1' Compare each cell of the current row with the previous row Dim rowMatch As Boolean rowMatch = True For n = 1 To colCount If cleanDataTbl.DataBodyRange.Cells(l, n).Value <> cleanDataTbl.DataBodyRange.Cells(m, n).Value Then rowMatch = False Exit For ' Exit loop if any cell is different End If Next n If rowMatch Then deleteRow = True Exit For ' Exit loop if duplicate row found End If Next m' If duplicate row found, delete the current row If deleteRow Then cleanDataTbl.ListRows(l).Delete End If Next l Else MsgBox "No table found on CleanDataWS worksheet.", vbExclamation End If' Analyze Point # column for remaining duplicates and apply formatting Set CleanDataWS = ThisWorkbook.Worksheets("CleanDataWS") Set tbl = CleanDataWS.ListObjects("CleanDataTBL") Set pointColClean = tbl.ListColumns("Point #").DataBodyRange For Each cellClean In pointColClean If WorksheetFunction.CountIf(pointColClean, cellClean.Value) > 1 Then tbl.Range.Rows(cellClean.Row).Interior.Color = RGB(255, 192, 192) tbl.Range.Rows(cellClean.Row).Font.Color = RGB(192, 0, 0) duplicateClean = True Else tbl.Range.Rows(cellClean.Row).Interior.ColorIndex = xlNone tbl.Range.Rows(cellClean.Row).Font.Color = RGB(0, 0, 0) End If Next cellClean If Not duplicateClean Then MsgBox "No duplicate Point #’s were found in the field data.", vbInformation End IfEnd Sub