Edit existing code

[Flavien]

Hi everyone,
I found on the web a code to collect the data recorded on all the workbooks of the same directory.
All workbooks have the same frame (tab name and table type).
I added "if" conditions in order to add the collection date and thus not collect the same line twice.
But it turns out that in the field, several colleagues may need to collect these lines.

But when I remove the IF lines, nothing happens.
To tell you the truth, I'm not sure I fully understand the construction of this code.

Does anyone have any idea how to go about collecting all the rows at will?

Or maybe clear all the dates before launching the code?

Thank you for your help.

Sub Collecte()

'Boucle sur tous les classeurs FNC ilot et transfère les données vers ce classeur.
'Les lignes collectées sont datées dans les fichiers sources afin d'éviter les doublons

Dim BDD As FileDialog 'déclare la variable BDD (Boîte de Dialogue Dossier)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim FS As String 'décalre la variable FS (Fichier Source)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (celllue de DESTination)


'Désactive la mise à jour de l'écran 
Application.ScreenUpdating = False

'chemin d'accès au dossier de stockage des classeurs FNC Ilots
CA = "P:\01-Qualité\K - Qualité Usinage\00 - Modèle" & "\"

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets("SUIVI") 'définit l'onglet destination OD
FS = Dir(CA & "TABLEAU DES FNC_*.xlsx") 'définit le premier fichier source Excel contenu dans le dossier ayant CA comme chemin d'accès
Do While FS <> "" ' exécute tant qu'il existe des fichiers source
    Workbooks.Open CA & FS 'ouvre le fichier source FS
    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets("Tableau FNC") 'définit l'onglet source OS (à adapter à ton cas, ici j'ai mis le premier onglet)



For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 1) <> "" And OS.Cells(I, 60) = "" Then OS.Cells(I, 60) = "x"
Next I


For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 60) = "x" Then OS.Rows(I).Copy OD.Rows(OD.Cells(OD.Rows.Count, 2).End(xlUp).Row + 1)
Next I

For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 60) = "x" Then OS.Cells(I, 60) = Date
Next I


'Active la mise à jour de l'écran pour accélérer l'exécution
Application.ScreenUpdating = True


    CS.Close True 'ferme le claseur source CS (False sans enregistrer)
    FS = Dir 'définit le prochain fichier source excel du dossier ayant CA comme chemin d'accès
Loop 'boucle

' activer le classeur "tableau de suivi des FNC_Qualité et remplacer les X par la date du jour
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets("SUIVI") 'définit l'onglet destination OD (à adapter à ton cas, ici j'ai mis l'onglet "suivi")

For I = 2 To OD.Range("B65536").End(xlUp).Row
    If OD.Cells(I, 60) = "x" Then OD.Cells(I, 60) = Date
Next I

End Sub

 

[Micron]

Put a break point at the first line of the code. Do whatever you do to make the sub run and it will stop at the break point. Step through (F8) and watch what happens. Check your variable values and references after that line has been executed. This is one way to trouble shoot code that isn't working as expected.

I think you do not have Option Explicit (enforces variable declaration) at the top of this module because you do not declare "I" yet you seem to get away with it. IMO best to not use capital letters for variables in Excel vba because they look like column references at first glance.

As for how to get around the issue of a user needing to do this for rows/files that have already been processed, that depends on how you want or can allow things to happen. Prompt them if already done and just allow yes or no? Do it anyway and overwrite the file? Do it anyway and append their initials to the file and keep the one already processed? Don't use date, use their initials so that each user can make at least one file? Something else?

Using initials is just another idea of a suffix you can append instead of the date. That would tell you who made which file. Also could use Environ("username") or if that is too long, get the Environ property value and associate it with the initials within your code.

Not sure I agree with the logic of doing 3 loops like that code does. It can get very slow and may not be necessary. It looks to me like the process is
- loop over rows and check if condition A is true.
- if true, make something = x
- loop over rows again, check if condition B is true (something = x)
- if true copy something to another cell
- loop over the rows again and if something was copied, insert the date

Why not just loop over rows and if condition A is true, check condition B and if true, copy then offset and insert date (or initials or whatever)? One loop, not 3?
Perhaps I am missing something in the way I perceive what is happening in the code. Also, you should figure out the ending of the loop and put that in a variable, not calculate the end of the loop 3 times.
HTH

 

[Flavien]

Hello Micron,
Thank you very much for the time you devoted to my message. This allows me to approach the subject from another angle.
Initially the idea was to extract the lines contained in all the workbooks and to date the extraction so as not to create duplicates. but each user should be able to extract all rows if they want.
on the other hand, if we imagine this network of workbooks as communicating vessels, where each user returns to the original workbook the modifications he made to a line, then it does not matter to overwrite and copy all the lines each time they are extracted. ( the user will then be able to filter the lines he wants).
On the other hand, your advice for gaining speed is excellent. are you thinking of the "if, elseif..." or " function, or another?

 

[Micron]

I'm thinking of one loop, not three.

if condition A is true, check condition B and if true, copy then offset and insert date (or initials or whatever)

However, that suggestion is based on my guess as to what is currently happening.

 

[Flavien]

I'm thinking of one loop, not three.

However, that suggestion is based on my guess as to what is currently happening.

Hello Micron,
I'm finally diving back into this code. I'm very interested in your idea of displaying the user's name in a cell so that the same user only downloads each row once (and thus not have duplicates). I don't see how to do that simply at all. I guess you should have as many extra columns as there are users and put the user's name in a dedicated column.

Sub Collecte09_04_2024() 'Collecter

'Boucle sur tous les classeurs FNC ilot et transfère les données vers ce classeur.
'Les lignes collectées sont datées dans les fichiers sources afin d'éviter les doublons

Dim BDD As FileDialog 'déclare la variable BDD (Boîte de Dialogue Dossier)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim FS As String 'décalre la variable FS (Fichier Source)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (celllue de DESTination)
Dim xWb As Workbook
Dim clascompteur As String
Dim Claslauncher As String
estclasseurouvert = (Not xWb Is Nothing)
Dim Wb As Workbook
Dim ladate As Date
Dim v As Variant

    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets("Tableau FNC") 'définit l'onglet source OS (à adapter à ton cas, ici j'ai mis le premier onglet)


Dim strAdresse As String

    
'   Workbook name

chemin = ActiveWorkbook.Name
pos = InStr(chemin, ".xlsx")

Range("CD1") = Left(chemin, pos - 1)

strAdresse = Range("CD1").Value

' write username in dedicated column/row
For i = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(i, 1) <> "" And OS.Cells(i, 60) = "" Then OS.Cells(i, strAdresse) = Application.UserName
Next i

Thank you a lot for your help.

 

[Micron]

A column per user would probably be the simplest. Anything else I can think of is more complicated. Perhaps just before the line to write to the cell use Find to locate username column number and write to that column/row. That way if anyone moves columns around it should still work because you don't use a static number (e.g. Pierre is column 9).

OK, just thought of another, not too onerous idea. You could put all usernames in one cell (say at the very end of the row) as separated values (comma, semi colon, whatever) and before writing to the names cell use Instr function to see if their name is there. If not, add it and process the row. I don't know what it means to you if their name is there; perhaps don't do anything with the row? If cells(i,strAdresse) is where the names go then something like

Dim strUser As String
' more Dim's that follow

Dim v As Variant
strUser = Application.UserName
'other code next
If Instr(OS.Cells(i, strAdresse),strUserName) = 0 Then 'returns zero if string to find is not found
    OS.Cells(i, strAdresse) = OS.Cells(i, strAdresse) & "," & strUserName 'the comma is a separator
End If

I think I'd have a variable for the range to make it more concise:
Dim rng As Range
You would have to reset rng inside the loop so that for every iteration of the loop it gets a new address
Set rng = OS.Cells(i, strAdresse)

EDIT - then again, perhaps simpler for you to just keep the longer syntax.

 

[Flavien]

Hi Micron,

Thank you for your time, it helps me a lot.

If I understand your explanations correctly, I first retrieve the necessary information to locate the column and the row in which I want to add the name of the person copying the row. then in a second step I will add his name in the column assigned to him.

An error 1004 appears when running the "if Instr" line

If InStr(OS.Cells(i, CelAdresse), strUserName) = 0 Then

Do you have any idea how to debug this line?

Sub essaicode()

Dim strUser As String
Dim CelAdresse As String
Dim machaine As String
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim i As Integer



'   Désactive la mise à jour de l'écran pour accélérer l'exécution
    Application.ScreenUpdating = True

    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets("Tableau FNC") 'définit l'onglet source OS (à adapter à ton cas, ici j'ai mis le premier onglet)


    
'   1ere étape: récupérer le nom de ce classeur

    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")
    

'*************

    machaine = Left(Replace(chemin, " ", "_"), pos - 1)
    
    CelAdresse = Range(machaine).Address
    
    strUserName = Application.UserName



For i = 2 To OS.Range("B65536").End(xlUp).Row

If InStr(OS.Cells(i, CelAdresse), strUserName) = 0 Then 'returns zero if string to find is not found
    OS.Cells(i, CelAdresse) = OS.Cells(i, CelAdresse) & "," & strUserName 'the comma is a separator
End If
Next i



End Sub

 

[Micron]

Put a break point at the IF line and cause the code to run. F8 advances one line per key press. You can mouse over most variables to see what values they contain. I'm not an expert at Excel vba but I suspect that celAddresse contains a value that contains $ character, like $A$1. AFAIK, Cells expects numbers like Cells(3,5) so maybe that's the problem. You could try passing the string to Range() instead of Cells. Or instead of using a string variable, Dim a Range object and Set the range object by passing the string to it.

Basic troubleshooting is doing one or more of the following:
- add break point(s) or insert a Stop statement (you will have to remove either of these when finished troubleshooting)
- after a line has executed you can mouse over variables to see what they contain, or
- you can inquire in the immediate window by typing, for example: ?CelAddresse and hit Enter. A value should appear in the immediate window.
- mousing over doesn't usually tell you anything for object variables. You can inquire about any property that it may have. e.g. ?Worksheet.Name to ensure that the correct worksheet was is being referenced.
- you can learn to use the Locals Window and/or Watch Window to verify variable values as you step through the code (F8)
HTH

 

[Flavien]

Hello Micron,

Merci for your help. I'm taking it step by step.

Thanks to your wise advice, I finally managed to enter the user's name in the column dedicated to him.

I'm not closing the subject for the moment because I'm not yet at the end of my troubles.

Now all I have to do is manage the data transfer part. As we say in French "y a plus qu'à, enfin..."

Below is the revised code.

Sub essaicode2() '12/04/24

Dim strUser As String
Dim CelAdresse As String
Dim machaine As String
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim i As Integer
Dim strAddress As String
Dim rownum As Long
Dim rowcol As Long
Dim Coord As Long



    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets("Tableau FNC") 'définit l'onglet source OS (à adapter à ton cas, ici j'ai mis le premier onglet)


    
'   1ere étape: récupérer le nom de ce classeur

    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")
    

'*************

    machaine = Left(Replace(chemin, " ", "_"), pos - 1)
    
    CelAdresse = Range(machaine).Address
    
    strUserName = Application.UserName
    

'MsgBox machaine
'MsgBox CelAdresse


'*********

strAddress = Range(CelAdresse).Address

rownum = Range(strAddress).Row
rowcol = Range(strAddress).Column


'MsgBox rownum & "," & rowcol

Coord = rowcol & "," & rownum


'**********



For i = 2 To OS.Range("B65536").End(xlUp).Row

If InStr(OS.Cells(i, Coord), strUserName) = 0 Then 'returns zero if string to find is not found
    OS.Cells(i, Coord) = OS.Cells(i, Coord) & "," & strUserName 'the comma is a separator
End If
Next i



End Sub

 

[Micron]

This is the same as before, so what changed?
If InStr(OS.Cells(i, CelAdresse), strUserName) = 0

I finally managed to enter the user's name in the column dedicated to him.

The method I gave you would append all user names in one cell. See second paragraph of post 6. It would be like

To use a dedicated cell you will have to find the column in row 1 (?) whose header is the username, then check if their name is in that column in the row you are processing. You would not uses the Instr part at all.