Sub AssemblyDataRetrieve()
Dim DataWkBk As Workbook
Dim DataWkBkName1 As String
Dim DataWkBkName2 As String
Dim DataWkBkName1_1 As String
Dim DataWkBkName2_1 As String
Dim FolderOne As String
Dim FolderTwo As String
Dim FolderThree As String
Dim FolderFour As String
Dim SrcShtName As String
Dim SrchVal As String
Dim TargetShtName As String
Dim DataWBkPathAndName As String
Dim DataWBkPathAndName2 As String
Dim prodNumberIn As String
Dim batchNumberIn As String
Dim prodNumberOut As String
Dim batchNumberOut As String
Dim Year As String
Dim Year2 As String
Dim Awb As String
Dim cellSplit As String
Dim NmCheck As String
Dim NwWbk As String
Dim check1 As String
Dim check2 As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
check1 = 0
check2 = 0
Awb = ActiveWorkbook.Name
Sheets("Report").Activate
cellSplit = Range("G8").Value
If cellSplit = "" Then
Range("F8").Select
Selection.TextToColumns Destination:=Range("F8"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End If
If LCase(Range("F8").Value) = "inner" Or LCase(Range("F8").Value) = "outer" Then
batchNumberIn = Range("G8").Value
batchNumberOut = Range("I8").Value
Else
batchNumberIn = Range("F8").Value
batchNumberOut = Range("G8").Value
End If
prodNumberIn = 10601331
prodNumberOut = 10601329
Year = Right(Range("D5").Value, 4)
Year2 = Year - 1
DataWkBkName1 = prodNumberIn & "_ac_rev-?_DTS Inner 12 inch+angle_" & batchNumberIn & "*.xls"
DataWkBkName1_1 = prodNumberIn & "_ac_rev-?_DTS Inner 12 inch+angle_" & batchNumberOut & "*.xls"
DataWkBkName2 = prodNumberOut & "_ac_rev-?_DTS_Outer 12 inch+angle_" & batchNumberOut & "*.xls"
DataWkBkName2_1 = prodNumberOut & "_ac_rev-?_DTS_Outer 12 inch+angle_" & batchNumberIn & "*.xls"
FolderOne = "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\0_WC_340_Duramax\DuraMax_144461\"
FolderTwo = "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\0_WC_340_Duramax\DuraMax_144751\"
FolderThree = "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year2 & "\0_WC_340_Duramax\DuraMax_144461\"
FolderFour = "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year2 & "\0_WC_340_Duramax\DuraMax_144751\"
SrcShtName = "Report"
TargetShtName = "Report"
DataWBkPathAndName = FolderOne & DataWkBkName1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderOne & DataWkBkName1_1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderTwo & DataWkBkName1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderTwo & DataWkBkName1_1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderThree & DataWkBkName1_1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderThree & DataWkBkName1_1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderFour & DataWkBkName1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
DataWBkPathAndName = FolderFour & DataWkBkName1_1
If FileExists(DataWBkPathAndName) Then
Workbooks.Open DataWBkPathAndName
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check1 = 1
GoTo EINDE1
End If
EINDE1:
DataWBkPathAndName2 = FolderOne & DataWkBkName2
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderTwo & DataWkBkName2
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderThree & DataWkBkName2
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderFour & DataWkBkName2
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderOne & DataWkBkName2_1
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderTwo & DataWkBkName2_1
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderThree & DataWkBkName2_1
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
DataWBkPathAndName2 = FolderFour & DataWkBkName2_1
If FileExists(DataWBkPathAndName2) Then
Workbooks.Open DataWBkPathAndName2
Sheets(SrcShtName).Activate
NwWbk = ActiveWorkbook.Name
Sheets("Report").Copy After:=Workbooks(Awb).Sheets(5)
Workbooks(Awb).Activate
Sheets("Report (2)").Activate
NmCheck = Left(Range("B8").Value, 9)
Sheets("Report (2)").Name = NmCheck
Workbooks(NwWbk).Close
check2 = 1
GoTo EINDE2
End If
EINDE2:
If check1 = 1 Then
Sheets(6).Activate
Awb = ActiveSheet.Name
End If
If check2 = 1 Then
Sheets(7).Activate
NmCheck = ActiveSheet.Name
End If
If check = 1 & check2 = 1 Then
If Awb >= NmCheck Then
Sheets(7).Move Before:=Sheets(6)
End If
End If
If check1 = 1 Then
Sheets(6).Activate
Range("17:17,22:34,36:36,43:45").Copy
Sheets("3001120").Select
Rows("42:42").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A42:J59").Select
Selection.Cut Destination:=Range("B42:K59")
End If
If check2 = 1 Then
Sheets(7).Activate
Range("15:15,16:16,18:24,34:36").Copy
Sheets("3001120").Select
Rows("62:62").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A62:J74").Select
Selection.Cut Destination:=Range("B62:K74")
End If
Sheets("Report").Activate
If LCase(Range("F8").Value) = "inner" Or LCase(Range("F8").Value) = "outer" Then
batchNumberIn = Range("G8").Value
batchNumberOut = Range("I8").Value
Range("F8:I8").ClearContents
Range("F8") = batchNumberIn & " / " & batchNumberOut
End If
If check1 = 1 & check2 = 1 Then
DoEvents
Sheets("3001120").Activate
MsgBox "Controleer of de data van de Inner en Outer in de actieve sheet onder rij 41 en rij 61 aanwezig is. Indien er geen data aanwezig is, kan dit het volgende betekenen: 1)Geen meting aanwezig van de Inner/Outer 2) Het batchnummer is niet goed ingevuld. De data moet nadat er op Ok gedrukt wordt te zien zijn"
End If
If check1 = 0 Or check2 = 0 Then
Sheets("3001120").Activate
MsgBox "Alleen de Inner of de Outer is gevonden en in dit rapport geplaatst. Oorzaak kan zijn dat het batchnummer niet goed ingevuld was, of dat de meting van de inner of outer niet dit jaar of het jaar ervoor gemeten was."
End If
ActiveWorkbook.Save
End Sub