Consolidating test if value exists before consolidating data?

A

Avais

New Member
Joined
Apr 11, 2016
Messages
7
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
 
Sort by date Sort by votes
Or
'Test for ID Match
outerdoctest = IsNumeric(Application.Match(ID, Workbooks(masterfiles).Worksheet(2).Columns("A"), 0))
 
Upvote 0
Declare the argument.
Code: 
Public Function outerdoctest(myfile As String, [B]MasterFile as String[/B]) As Boolean

Use the passed masterfile argument within the function
Code: 
outerdoctest = IsNumeric(Application.Match(ID, Workbooks([B]MasterFile[/B]).Worksheets(2).Columns("A"), 0))

Call the function while passing the two arguments
Code: 
If outerdoctest(myfile, [B]masterfile[/B]) Then


Always post code using CODE tags.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Incorporating my VBA code (that saves all sheets from an excel workbook to CSV) into a looping VBA program (just have myself stumped!)
Replies
3
Views
1K
Anthony47
A
A
  • Question Question
Importing cell values from multiple workbooks in one folder
Replies
2
Views
933
Albertu95
A
G
  • Question Question
Select folder, unformat & clean up certain sheets within workbooks & consolidate those certain sheets into a single workbook
Replies
0
Views
742
griff78
G
willow1985
  • Question Question
Help with VBA code - Open Files as read only and don't update links
Replies
3
Views
8K
DanteAmor
DanteAmor
G
  • Question Question
VBA Loop to replace a worksheet in multiple workbooks
Replies
0
Views
1K
gadisal
G

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top