I have written some code that brings in a .dat file data (4 columns of survey data). These columns can be up to 100 000 rows or more. When I run the macro it occassionally stops copying or putting the values in after a certain amount of cells (which varies) and I can't work out why. I have assumed that it is because the macro is moving on to the next line of code before the previous "pasting" of values has completed maybe? I am only pretty new to VBA and maybe I haven't used the correct variable type maybe?? I have added some loops in after these actions today and it seems ok so far but I would love some feedback if anyone can help me out PLEASE... This is my first post on this forum, hopefully I have done it correctly.
Sub CATAN_Convert() ' Conversion Macro On Error GoTo errorhandler 'Variable Declarations Dim NumShots As Long Dim wbname As String, wsname As String, fullpath As String, sp As String, coords2 As String Dim name1 As String, name2 As String, pastearea As String, pastearea2 As String, coords As String Dim wsnew As Worksheet Dim a As Variant Dim i As Long 'Stop screen from flickering while windows change Application.ScreenUpdating = False ' Asks you where the file you want to convert is located With Application.FileDialog(msoFileDialogFilePicker) 'Start of picking your file .AllowMultiSelect = False 'Allows you to only open one file .Filters.Add "Text Files", "*.dat", 1 'Looks only for .dat files .Show 'Opens the File Dialog Box fullpath = .SelectedItems.Item(1) 'Assigns the location of the file to the variable "fullpath" End With 'Exits the search function If Right(fullpath, 3) <> "dat" Then 'Error trap in case you don't select a dat file MsgBox ("You need to select a .dat file!") 'Message box to advise user that a dat file wasn't selected GoTo errorhandler 'Sends you to the error trap which will close code down End If 'End of picking your file 'Assigning variable fullpath to full address of file and imports file data into the dat file correctly delimited Workbooks.OpenText Filename:= _ fullpath, _ Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _ Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True wbname = ActiveWorkbook.Name 'Assigns variable wbname to the name of this workbook wsname = ActiveSheet.Name 'Assigns variable wsname the name of this worksheet NumShots = Application.WorksheetFunction.CountA(Range("A:A")) 'Counts the number of survey points in the file Set wsnew = Sheets.Add(After:=Sheets(wsname)) 'Adds a new worksheet 'Copies the co-ordinate converter section of the main file to this dat file Windows("CATAN Converter.xlsm").Activate 'Activates main workbook Sheets("Sheet2").UsedRange.Copy Destination:=Workbooks(wbname).Worksheets("Sheet1").Range("A1") 'Copies conversion data over Windows(wbname).Activate 'Goes back and selects our new dat workbook pastearea = "G5:AF" & NumShots + 3 'Assigns the variable pastearea the value of the cells we need to paste to Range("G4:AF4").Copy Destination:=ActiveSheet.Range(pastearea) 'Copies the formulas from cells G4 to AF4 Do While Workbooks(wbname).Worksheets("Sheet1").Range("AF" & NumShots + 3) = "" Loop ActiveWorkbook.Worksheets(1).Activate 'Selects the first worksheet in the workbook pastearea2 = "A1:B" & NumShots 'Assigns the variable pastearea2 the value of all the cells we need to copy 'Sheets("Sheet1").Range("D4:E" & NumShots + 3).Value = Range(pastearea2).Value 'Copies co-ordinates to conversion sheet Sheets(wsname).Range(pastearea2).Copy Destination:=Worksheets("Sheet1").Range("D4") Do While Worksheets(wsname).Range("B" & NumShots) = "" Loop Sheets("Sheet1").Select 'Selects our co-ordinate transformation sheet1 Range("A1").Select 'Selects cell A1 to prevent any confusion 'Copy converted co-ordinates back to final sheet coords = "AD4:AE" & NumShots + 3 'Assigns the variable coords the value of all the converted co-ordinate cells we need to copy With Sheets("Sheet1").Range(coords) Worksheets(wsname).Range(pastearea2).Value = .Value End With Range("A1").Select 'Selects cell A1 to prevent any confusion Sheets("Sheet1").Select 'Selects Sheet1 Application.DisplayAlerts = False 'Turns off Display of box asking to accept sheet deletion ActiveWindow.SelectedSheets.Delete 'Deletes Sheet1 Application.DisplayAlerts = True 'Turns display alerts back on ' Converts Feature Codes to CATAN usable format With Range("D1", Range("D" & Rows.Count).End(xlUp)) a = .Value For i = 1 To UBound(a) Select Case a(i, 1) Case 700: a(i, 1) = vbNullString Case 400: a(i, 1) = "%po" Case Else: a(i, 1) = "%sp" End Select Next i .Value = a End With 'Saving of new file for CATAN name1 = InStrRev(fullpath, ".") 'Counts the number of characters in front of the . in the file name name2 = Left(fullpath, name1) 'Grabs the name of the file using the character count above 'Uses the filename from above and puts csv after it so that it saves to the same location as a different file type ActiveWorkbook.SaveAs Filename:= _ name2 & "csv", FileFormat:=xlCSV, CreateBackup:=False MsgBox "Created " & name2 & "csv for use in CATAN." & vbNewLine & "File location same as original file location" 'Advises user the file location ActiveWorkbook.Close 'Closes this file Workbooks("CATAN Converter.xlsm").Close savechanges:=False 'Closes the Master workbook Exit Sub errorhandler: MsgBox "An Error has occurred." & vbNewLine & "Please re-run." Exit Sub End Sub