Consolidating test if value exists before consolidating data?

[Avais]

Hi So basically I have a created a code which asks the user to pick a folder which it then consolidates those file which are in the folder to a master sheet from multiple excel file.

I want the code to test if the file is already imported by referencing the data already on the master sheet. Each file has a unique ID which is on the filename within the folder and in the master sheet. So basically once it starts to import it test each file name and checks if the ID is found on the master sheet, if true then go to next file until it finds a file which hasn't been imported.

I need a code which can do this, here is my code below. I have a test called outerdoctest which I hope will be able to do the test and so on...




Public Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myfile As String
Dim myExtension As String
Dim FldrPicker As FileDialog, Varfile As Variant
Dim Filecount As Long, Filelist() As String, Changecount As Long, NROLcount As Long, Lastrow As Long, Startblock As Long
Dim Filename As Variant
Dim Masterfile As String

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Masterfile = ActiveWorkbook.Name

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

FldrPicker.Title = "Select A Target Folder"
FldrPicker.AllowMultiSelect = False
If FldrPicker.Show Then
For Each Varfile In FldrPicker.SelectedItems
myPath = myPath & Varfile & "\"
Next

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"


'Target Path with Ending Extention

ReDim Filelist(0)
Filecount = -1
Filename = Dir(myPath & myExtension, vbNormal)
Do Until Filename = ""
If Left(Filename, 1) <> "." Then
Filecount = Filecount + 1
ReDim Preserve Filelist(Filecount)
Filelist(Filecount) = Filename
End If
Filename = Dir()
Loop

Windows(Masterfile).Activate
Sheets(2).Select

' *************************************************************
' URGENT FIND LASTROW DO NOT SET TO 2 BY DEFAULT
'
Lastrow = 2
Do Until Cells(Lastrow, 1) = ""
Lastrow = Lastrow + 1
Loop
' ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' *************************************************************

'Loop through each Excel file in folder
For Changecount = 0 To Filecount
myfile = Filelist(Changecount)


'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myfile)
ActiveWorkbook.Unprotect Password:="etp"

NROLcount = 0
NROLcount = InnerDocCount(myfile, NROLcount)
Windows(Masterfile).Activate
ActiveWorkbook.Unprotect Password:="etp"
Sheets(2).Select
If NROLcount <> 0 Then
If outerdoctest(myfile) Then
Windows(Masterfile).Activate
Sheets(2).Select
If innerdoctest(myfile) Then
Windows(Masterfile).Activate

Sheets(2).Select
ActiveSheet.Unprotect Password:="etp"
' Copy Outer document to row (Repeat as required

'ID
Cells(Lastrow, 1).Formula = "='[" & myfile & "]CHANGE FORM'!D4"
'Week running
Cells(Lastrow, 2).Formula = "='[" & myfile & "]CHANGE FORM'!L15"
'Year Running
Cells(Lastrow, 3).Formula = "='[" & myfile & "]CHANGE FORM'!L17"

' 'PT/OTM Number
' Cells(Lastrow, 4).Formula = "='[" & myFile & "]CHANGE FORM'!E" & Startblock
' 'PT/OTM
' Cells(Lastrow, 5).Formula = "='[" & myFile & "]CHANGE FORM'!H" & Startblock
' 'Change Type
' Cells(Lastrow, 6).Formula = "='[" & myFile & "]CHANGE FORM'!K" & Startblock
' 'Change Category
' Cells(Lastrow, 7).Formula = "='[" & myFile & "]CHANGE FORM'!M" & Startblock
'

'Area
Cells(Lastrow, 8).Formula = "='[" & myfile & "]CHANGE FORM'!E15"
'Route
Cells(Lastrow, 9).Formula = "='[" & myfile & "]CHANGE FORM'!J15"
'Poss#
Cells(Lastrow, 10).Formula = "='[" & myfile & "]CHANGE FORM'!J19"
'Worksite#
Cells(Lastrow, 11).Formula = "='[" & myfile & "]CHANGE FORM'!L19"
'Worksite Name#
Cells(Lastrow, 12).Formula = "='[" & myfile & "]CHANGE FORM'!L21"
'Requestor Nr Functional Unit
Cells(Lastrow, 13).Formula = "='[" & myfile & "]CHANGE FORM'!F11"
'Requestor NR Cause functional unit
Cells(Lastrow, 14).Formula = "='[" & myfile & "]CHANGE FORM'!K9"
'Nr Affected Functional Unit
Cells(Lastrow, 15).Formula = "='[" & myfile & "]CHANGE FORM'!J21"
'NR Affected Cause functional unit
Cells(Lastrow, 16).Formula = "='[" & myfile & "]CHANGE FORM'!E21"
'Main Cause of change
Cells(Lastrow, 17).Formula = "='[" & myfile & "]CHANGE FORM'!F25"
' Cause Function:
Cells(Lastrow, 18).Formula = "='[" & myfile & "]CHANGE FORM'!F27"
'Cause Functional Unit:
Cells(Lastrow, 19).Formula = "='[" & myfile & "]CHANGE FORM'!K27"
'Post T-4 Lockdown
Cells(Lastrow, 20).Formula = "='[" & myfile & "]CHANGE FORM'!L25"



'Justification for change
Cells(Lastrow, 21).Formula = "='[" & myfile & "]CHANGE FORM'!F29"

' 'Additional change
' Cells(Lastrow, 22).Formula = "='[" & myFile & "]CHANGE FORM'!F" & Startblock + 2

'Requestor Date
Cells(Lastrow, 23).Formula = "='[" & myfile & "]CHANGE FORM'!F7"
'Requestor Name
Cells(Lastrow, 24).Formula = "='[" & myfile & "]CHANGE FORM'!F9"
'Requestor Week
Cells(Lastrow, 25).Formula = "='[" & myfile & "]CHANGE FORM'!K7"
'Contractor ID
Cells(Lastrow, 26).Formula = "='[" & myfile & "]CHANGE FORM'!K11"
'PM
Cells(Lastrow, 27).Formula = "='[" & myfile & "]CHANGE FORM'!D82"
'PM NAME
Cells(Lastrow, 28).Formula = "='[" & myfile & "]CHANGE FORM'!J82"
'Approval PM
Cells(Lastrow, 29).Formula = "='[" & myfile & "]CHANGE FORM'!F82"
'Refusal PM
Cells(Lastrow, 30).Formula = "='[" & myfile & "]CHANGE FORM'!F84"
'Date PM
Cells(Lastrow, 31).Formula = "='[" & myfile & "]CHANGE FORM'!L82"
'RPM
Cells(Lastrow, 32).Formula = "='[" & myfile & "]CHANGE FORM'!D90"
'RPM NAME
Cells(Lastrow, 33).Formula = "='[" & myfile & "]CHANGE FORM'!J90"
'Apporval RPM
Cells(Lastrow, 34).Formula = "='[" & myfile & "]CHANGE FORM'!F90"
'Refusal RPM
Cells(Lastrow, 35).Formula = "='[" & myfile & "]CHANGE FORM'!F92"
'Date RPM
Cells(Lastrow, 36).Formula = "='[" & myfile & "]CHANGE FORM'!L90"
'NSC
Cells(Lastrow, 37).Formula = "='[" & myfile & "]CHANGE FORM'!D97"
'NSC NAME
Cells(Lastrow, 38).Formula = "='[" & myfile & "]CHANGE FORM'!J97"
'Approval NSC
Cells(Lastrow, 39).Formula = "='[" & myfile & "]CHANGE FORM'!F97"
'Refusal NSC
Cells(Lastrow, 40).Formula = "='[" & myfile & "]CHANGE FORM'!F99"
'Date NSC
Cells(Lastrow, 41).Formula = "='[" & myfile & "]CHANGE FORM'!L97"
'RMD
Cells(Lastrow, 42).Formula = "='[" & myfile & "]CHANGE FORM'!D105"
'RMD NAME2
Cells(Lastrow, 43).Formula = "='[" & myfile & "]CHANGE FORM'!J105"
'Approval RMD
Cells(Lastrow, 44).Formula = "='[" & myfile & "]CHANGE FORM'!F105"
'Refusal RMD
Cells(Lastrow, 45).Formula = "='[" & myfile & "]CHANGE FORM'!F107"
'Date RMD
Cells(Lastrow, 46).Formula = "='[" & myfile & "]CHANGE FORM'!L105"
'NSC TO CP NAME
Cells(Lastrow, 47).Formula = "='[" & myfile & "]CHANGE FORM'!F114"
'CP DATE SENT
Cells(Lastrow, 48).Formula = "='[" & myfile & "]CHANGE FORM'!L114"
'VSTP
Cells(Lastrow, 49).Formula = "='[" & myfile & "]CHANGE FORM'!E4"


' NROLcount = InnerDocCount(myFile, NROLcount)
Do Until NROLcount = 0
Startblock = 36 + (9 * (NROLcount - 1))
'
Windows(Masterfile).Activate
Sheets(2).Select
'PT/OTM Number
Cells(Lastrow, 4).Formula = "='[" & myfile & "]CHANGE FORM'!E" & Startblock
'PT/OTM
Cells(Lastrow, 5).Formula = "='[" & myfile & "]CHANGE FORM'!H" & Startblock
'Change Type
Cells(Lastrow, 6).Formula = "='[" & myfile & "]CHANGE FORM'!K" & Startblock
'Change Category
Cells(Lastrow, 7).Formula = "='[" & myfile & "]CHANGE FORM'!M" & Startblock

'Additional change
Cells(Lastrow, 22).Formula = "='[" & myfile & "]CHANGE FORM'!F" & Startblock + 2

Range("A" & Lastrow & ":AW" & Lastrow).Select

Selection.Copy
Cells(Lastrow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Application.CutCopyMode = False
Lastrow = Lastrow + 1

Range("A" & Lastrow - 1 & ":AW" & Lastrow - 1).Select
Selection.Copy
Cells(Lastrow, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

NROLcount = InnerDocCount(myfile, NROLcount)
If NROLcount <> 0 Then
Windows(Masterfile).Activate
Sheets(2).Select
Range("A" & Lastrow - 1 & ":AW" & Lastrow - 1).Select
Selection.Copy
Cells(Lastrow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Loop
End If
End If
End If

Windows(myfile).Activate
ActiveWorkbook.Close SaveChanges:=False
Windows(Masterfile).Activate
Sheets(2).Select


Next Changecount

Else
MsgBox "No Folder selected"
' No Files Picked
End If
Call RefreshAllPivotTables

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub




Public Function outerdoctest(myfile As String) As Boolean


outerdoctest = True
outerdoctest = False

End Function

 

[AlphaFrog]

Hi So basically I have a created a code which asks the user to pick a folder which it then consolidates those file which are in the folder to a master sheet from multiple excel file.

I want the code to test if the file is already imported by referencing the data already on the master sheet. Each file has a unique ID which is on the filename within the folder and in the master sheet. So basically once it starts to import it test each file name and checks if the ID is found on the master sheet, if true then go to next file until it finds a file which hasn't been imported.

I need a code which can do this, here is my code below. I have a test called outerdoctest which I hope will be able to do the test and so on...

Please take note of my signature block below about the use of CODE tags. It makes reading your posted code much easier.

How\where is the ID determined? Is the ID part of the file name? If yes, how is the ID in the file name; describe the naming convention and give examples?

Then you want to search column A to test if the ID exists?

 

[Avais]

Sorry relatively new on here, the ID is self generated via another piece of code. Each file is saved in a folder once it is complete. Every week we upload new file which have been completed.

So this ID is saved onto the filename and also exist within the excel file. When I consolidate the data the macro copy's the ID onto the master sheet which is how it can then be referenced. So just to be clear the ID is in the each excel file in sheet 2 range(D:4). Typical ID looks like this Western 41 070416 154419.

Then I want check to see if column A has the ID, this indicated the data has been consolidated and doesn't need to be rerun and looks for any new excel file which have not been uploaded. which can then be consolidated onto the master sheet which prevents duplication. Sorry if this is a little confusing.

 

[AlphaFrog]

Can you give some examples of whole file names so I can see how to extract the ID from the file names.

The alternative is to open every file and get the ID from Sheet2 D4. This would be slower if you had a lot of files that were already consolidated.

 

[Avais]

Can you give some examples of whole file names so I can see how to extract the ID from the file names.

The alternative is to open every file and get the ID from Sheet2 D4. This would be slower if you had a lot of files that were already consolidated.

This is a typical file name: Western 41 070416 154419.xls

 

[Avais]

This is a typical file name: Western 41 070416 154419.xls

Public Function outerdoctest(myfile As String) As Boolean
Dim mydoc As String
Dim i As Integer
ActiveSheet = mydoc


i = i + 1
If Masterfile.Worksheets(2).Cells(i + 1, 1).Value = mydoc.Worksheets(5).Cells(1, 4) Then
outerdoctest = False
Else
outerdoctest = True


End Function

This gives me an error not sure if this is on the right track?

 

[AlphaFrog]

Again, please use code tags.

Try something like this...

[color=darkblue]Public[/color] [color=darkblue]Function[/color] outerdoctest(myfile [color=darkblue]As[/color] [color=darkblue]String[/color]) [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
    
    [color=darkblue]Dim[/color] ID [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    [color=green]'Extract ID from file name[/color]
    ID = Left(myfile, InStrRev(myfile, ".") - 1)
    
    [color=green]'Test for ID Match[/color]
    outerdoctest = IsNumeric(Application.Match(ID, ThisWorkbook.Sheets(2).Columns("A"), 0))
    
[color=darkblue]End[/color] [color=darkblue]Function[/color]

 

[Avais]

Thanks for the reply, just to note that the master sheet is on a separate excel workbook. In another sub routine I have named the file masterfile. Can I use the variable set in another sub in this sub. If so how can it retain the value it holds.

 

[AlphaFrog]

Thanks for the reply, just to note that the master sheet is on a separate excel workbook. In another sub routine I have named the file masterfile. Can I use the variable set in another sub in this sub. If so how can it retain the value it holds.

Pass it to the function as an argument like you do you myfile.

 

[Avais]

'Test for ID Match
outerdoctest = IsNumeric(Application.Match(ID, masterfiles.Worksheets(2).Columns("A"), 0))

This doesn't work sorry for the hassle.