VBA - import a dat file into Excel and copy the rows if column "A" equals "CC"

[george hart]

Hi all

I some code that opens dat files in a certain folder, attempts to copy the rows if column "A" equals "CC" into one sheet then moves the dat files to another folder. For some reason though the macro just hangs and then Excel crashes...any ideas most welcome??????

The code has two parts - Part 1 - gets the dat files

Sub Get_Files()


Dim folderPath As String
Dim filename As String
Dim wb As Workbook
  
    folderPath = ThisWorkbook.Path & "\" & "Imports" & "\"
    strPath = ThisWorkbook.Path & "\" & "Archive" & "\"
        
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    
    filename = Dir(folderPath & "*.dat")
    If filename = "" Then MsgBox "The Imports folder is empty, you need the appropriate Dat files in order to run this Macro", vbInformation, "Emtpy Folder Alert"
    If filename = "" Then Exit Sub
    Do While filename <> ""
        Set wb = Workbooks.Open(folderPath & filename)
        
        'Workbooks.OpenText filename:=wb, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        'xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma _
        ':=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, _
        '1), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        'TrailingMinusNumbers:=True
        
        Call Get_Data
        strFileName = Format(Now(), "yyyy-mm-dd") & "_" & ActiveWorkbook.Name & "CSV"
        wb.SaveAs filename:=strPath & strFileName, FileFormat:=xlCSV
        wb.Close SaveChanges:=False
        
filename = Dir
    Loop


    Kill folderPath & "*.Dat"


End Sub

While part two copies the required data:

Sub Get_Data()


For x = 4 To Cells(Rows.Count, "A").End(xlUp).Row
For y = 1 To Cells(Rows.Count, "A").End(xlUp).Row


'CC
If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Range("A" & y).Offset(1)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range("A" & y).Offset(0, 1)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range("A" & y).Offset(0, 2)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Range("A" & y).Offset(0, 3)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Range("A" & y).Offset(0, 4)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Range("A" & y).Offset(0, 5)


If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Range("A" & y).Offset(0, 6)


Next
Next


End Sub

 

[mrmmickle1]

Did you try stepping through the code using F8 to identify any inconsistencies or issues?

 

[george hart]

Did you try stepping through the code using F8 to identify any inconsistencies or issues?

I have tried that and although Get_Files() appears to open the dat file with no errors, when I step through Get_Data() I do get errors on the code below which is strange as I've this code before and it worked fine - mystery???

If Range("A" & y).Value = "CC" Then _
Workbooks("Testing.xlsm").Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Range("A" & y).Offset(0, 4)

 

[mrmmickle1]

What is your y value when the code errors out?

What is the error number and description?