I'm working on a report of quality control. I have a list L, which contains the names of files that I should open and import the data into EXCEL, then fill my quality control table by these data.

And at the end, I want to know which file in the list has not been opened, that means this file (or this point of control) is a new one for the former lists of control.

So I've commanded EXCEL to note every file that I've opened in a list A, and delete the repeating parts, then compare the new one B with the list L. Here is my code:

'to chose the list L
Private Sub Button_Parcourir_Click()

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .InitialFileName = "import_excel.txt"
    listPath = .SelectedItems(1)
End With
TextBox1.Text = listPath
End Sub

Private Sub Button_Importer_Click()

'calculate the time:
c = Timer
Dim costTime As Single
'forbidden the screen to refresh:
Application.ScreenUpdating = False
'create a sheet named "Brouillon":
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Brouillon"

'open the list L and import the data into "Brouillon":
list_de_Controle = "TEXT;" & listPath
Open listPath For Input As #1
Do While Not EOF(1)
    Line Input #1, nom_de_Fich
    mfile = Dir(nom_de_Fich & "*.*")

    If mfile <> "" Then
        Open nom_de_Fich For Input As #2
        Close #2
    End If
Close #1

'count how many lines and columns we have in "Data":
'(I've tried a simplier method but it didn't work well)
ligne_Data = Selection.Row
ma_Colonne = Selection.Column + 1

'count how many lines and columns we have in "Brouillon":
'put a flag to reduce the loop
marque_ligneBrouillon = 1

Set new_arrList = CreateObject("System.Collections.ArrayList")
'for each line in "Data":
For i = 4071 To ligne_Data
    'find which file I should open (mon_objet):
    mon_objet = Sheets("Data").Cells(i, 15).Text        
    'begin to search in "Brouillon" (from the last time where it stopped):
    For j = marque_ligneBrouillon To ligne_Brouillon

        'check the file:
        If InStr(Sheets("Brouillon").Cells(j, 1).Text, mon_objet) <> 0 Then
            'put this file in arrList:
            arrList.Add Sheets("Brouillon").Cells(j, 1).Text
            'check the zone:
            If InStr(Sheets("Brouillon").Cells(j, 2).Text, Sheets("Data").Cells(i, 18).Text) <> 0 _
                Or InStr(Sheets("Data").Cells(i, 18).Text, "/") <> 0 Then

                'in the correct line in "Brouillon" from the beginning till the end:
                For k = 2 To colonne_Brouillon

                    'check the control whose result I'm looking for:
                    If InStr(Sheets("Brouillon").Cells(j, k).Text, Sheets("Data").Cells(i, 20).Text) <> 0 Then

                        'if this cell contains the result:
                        '1. put the mark here
                        marque_ligneBrouillon = j
                        '2. put the result inside:
                        mon_Data = Sheets("Brouillon").Cells(j, k).Text
                        Sheets("Data").Cells(i, ma_Colonne).Value = mon_Data
                        Flag_j = True
                        Exit For
                    End If

                Next k

            End If

        End If
        If Flag_j Then Exit For

    Next j
    Flag_j = False

Next i    
'[[[Here is the code to compare the two lists]]]================
Set new_arrList = CreateObject("System.Collections.ArrayList")
nb = arrList.Count
For x = 0 To (nb - 1)
    For y = x To (nb - 1)
        If arrList(y) = arrList(x) Then Count = Count + 1
    Next y
    If Count = 1 Then new_arrList.Add arrList(x)
    Count = 0
Next x

'show the time:
costTime = Timer - c
Debug.Print "comparer les deux listes :" & (costTime * 1000) & " ms"

End Sub

Public Sub Inserer_Nom_Fich()

ActiveCell.Value = nom_de_Fich
ActiveCell.Offset(0, 1).Select

End Sub

Public Sub Inserer_contenu()

Dim keyWord As String

keyWord = "Zone"

Do While Not EOF(2)
    Line Input #2, contenu
    'if it's a new zone:
    If InStr(contenu, keyWord) < 1 Then
        ActiveCell = contenu
    'if it's not:
        ActiveCell.Offset(1, 0).Select
        ActiveCell = contenu
    End If

    ActiveCell.Offset(0, 1).Select

ActiveCell.Offset(1, 0).Select

End Sub

Public Sub Count_Brouillon()

ligne_Brouillon = Sheets("Brouillon").UsedRange.Rows.Count
colonne_Brouillon = Sheets("Brouillon").UsedRange.Columns.Count

End Sub

But I've found that this method works slowly. So if you've some idea to improve my code, or even better, you have some idea to compare these two lists or to find out which file I've not opened during the filling period, please leave a comment.

  • \$\begingroup\$ Hi and welcome to Code Review. It would be really useful if we could see the entire context for your code. Say, everything in this particular sub/function including the method signature. Right now, we can offer advice, but there's only *so* much we can improve without the wider context in which it operates. \$\endgroup\$ – Kaz Jun 29 '16 at 8:35
  • \$\begingroup\$ How do your lists have any data in them, when all you're doing is creating empty objects and never filing them? \$\endgroup\$ – Kaz Jun 29 '16 at 8:45
  • \$\begingroup\$ Thank you, it's so kind of you! But actually, for the lists, this is the only part that concerns. The rest of code aims to import the data into a new sheet (I want to creat a new sheet for reserving the new data) in EXCEL, and fill the report with it. So I don't know which part do you need the most? \$\endgroup\$ – Hiddenllyy Jun 29 '16 at 8:47
  • \$\begingroup\$ The easiest thing to do would just be to copy/paste everything between Sub and End Sub (or function). It's a lot easier to offer sugestions when you can see the context that a particular piece of code operates in. \$\endgroup\$ – Kaz Jun 29 '16 at 8:50
  • \$\begingroup\$ Hi@Zak, I've uploaded the entire (not so entire though) code, and do some comments. And sorry I work in France so the variables are all in french. If you need more informations just let me know. \$\endgroup\$ – Hiddenllyy Jun 29 '16 at 9:22

It seems to call for Collections

But I 'd here investigate an alternative technique exploiying the RemoveDuplicates() method of Range object

This method, as its name suggests, just removes any duplicate from a list of values in one or more columns of an excel sheet.

So you may store in two separated arrays the names of files you "should" open and those of the files actually opened

Dim AList As Variant ' list of file names that you "should" open
Dim BList As Variant ' list of file names that you'll actually open
Dim newList As Variant ' list of opened file names not in 'AList'

AList = array("fileName1", "fileName2",  "fileName3") ' list of file names that you "should" open: you already know them from the beginning

Then follows your code to loop over files and open them (be they in AList or not) and where at every file opening you want to take note of its name like follows:

Dim openedFileNames As String ' this statement is best to be typed by the beginning of your code toghether with all other 'Dim' statements

For .... ' I assume you use a For loop

    '.... code until you reach the succesful open file statement

    openedFileNames = openedFileNames & ws.Name & "|"

    ' rest of your loop code...


Where we chose the "|" charachter to separate file names

After exiting the files processing loop you are ready to set the ground and exploit RemoveDuplicates() method

Write down your BList array in any unused 1-column range of any already open worksheet (say we use column "A" of "MyAlreadyOpenSheet" worksheet) and remove its duplicates:

openedFileNames = Left (openedFileNames, Len(openedFileNames) - 1) ' remove the last "|" character
BList = Split(openedFileNames, "|") ' obtain an array from a `String` variable by means of 'Split()' function which requires a "separator" character to be specified (we specify the "|" character we already chose)

Dim nBUniqueVals As Long ' this statement is best to be typed by the beginning of your code toghether with all other 'Dim' statements
With Worksheets("MyAlreadyOpenSheet") ' reference your worksheet 
    .Range("A1").Resize(UBound(BList)).Value = Application.Transpose(BList) ' write 'BList' array down A column  

    With .Columns(1)
        .RemoveDuplicates Columns:=Array(1), Header:=xlNone ' remove duplicates
        nBUniqueVals = .SpecialCells(xlCellTypeConstants, xlTextValues).Count ' store BList unique values number
    End With 
   ' more code ...

End With

Then write down the AList array content right after it:

With Worksheets("MyAlreadyOpenSheet") ' reference your worksheet 


    .Range("A1").End(xlDown).Offset(1).Resize(UBound(AList)).Value = Application.Transpose(AList) ' write 'AList' array down A column after the last non empty cell

   ' more code ...

End With

I assume we don't need to remove duplicates from AList since it's a "static" list you yourself fill!

Now we're ready to use RemoveDuplicates() method on column "A" for the last time:

With Worksheets("MyAlreadyOpenSheet")


    With .Columns(1)
        .RemoveDuplicates Columns:=Array(1), Header:=xlNone

        ' more code...

    End With 

End With

Now your column "A" has the unique files names lists coming from both BList (first) and AList (after).

This means that any AList not opened file name will be listed after the last occurrence of (unique) BList values

So we only need to check if the remaining column "A" values are more than the above computed BList unique ones:

With Worksheets("MyAlreadyOpenSheet"


    With .Columns(1)
         nTotVals =.SpecialCells(xlCellTypeConstants, xlTextValues).Count
         If nTotVals > nBUniqueVals Then
            newList = Application.Transpose (.Cells(nBUniqueVals + 1, 1).Resize(nTotVals - nBUniqueVals))
        End If
    End With 
    ' more code...

End With

And so you have newList string wanted file names (if any)

| improve this answer | |
  • \$\begingroup\$ Good morning, sorry for this delay, I habe been attending the meetings last two days. And I've met a error` '1004' : Application-defined or object-defined error.` at this line : With .Columns(1) .RemoveDuplicates Columns:=Array(1), Header:=xlNone . I've successed to write the Blist in to a new work sheet, but to remove the duplicate; it's blocked. Please take a look of it when you're free. Thanks alot! \$\endgroup\$ – Hiddenllyy Jul 1 '16 at 7:02
  • \$\begingroup\$ I've resolved :) , just use Sheets("Brouillon").Columns(1).RemoveDuplicates Columns:=Array(1), Header:=xlNo and that works! \$\endgroup\$ – Hiddenllyy Jul 1 '16 at 9:54
  • \$\begingroup\$ Your code works really well and fast!! Thank you very much! Have a good day! \$\endgroup\$ – Hiddenllyy Jul 1 '16 at 11:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.