Getting data from multiple books and sheets with multiple conditions

bwells

New Member
Joined
Sep 10, 2014
Messages
1
I am creating a master database for work which gets specific data from a folder with multiple workbooks with multiple worksheets. Each workbook has the same form template on each worksheet used. However, a workbook could have 1 to 30 worksheets. The below code is what I have now with help from a past forum post. The end result is to look like Table 2. The code does everything I need except for two things.

1 - Need a loop to go through every worksheet in every workbook so code doesn't have to be copied for 1 to 30 worksheets.

2 - Conditional statement that states if a joint is accepted or rejected. If the joint is rejected then for what reason. There are 18 different reasons a joint is rejected, see Table 1, but for now lets say 1 to 18. One joint has a A, B, and C. If A, B, or C is marked as 1 of the 18 conditions then joint is rejected for that condition. If A, B, or C is not marked as 1 of the 18 condition then the joint is accepted.

Any help with this would be greatly appreciated.

Table 1
Project WPS NO Date Machine Number
OD WT
Fitting, Seam, Or Joint NumberFilm Interval Number SLAG Porosity Porosity with Tail Crack Lack of Penetration Lack of Fusion Internal CovexityInternal ConcavityTungstenMelt-Through Burn- Through Crater PitOxidation Internal UndercutExternal Undercut Aligned IndicationsWeld ContourMis-Match AcceptReject
clip_image001.png

<tbody>
</tbody>
1A WID
B
clip_image001.png
C
2A WID
B
C
3A WID
B
C
4A WID
B
C

<tbody>
</tbody><colgroup><col span="4"><col><col><col span="2"><col><col><col span="33"></colgroup>

<tbody>
</tbody>


Table 2
DateProject and Project EndWeld NumberAccept/RejectTube ODTube WTWeld ProcedureWelder IDWeld Machine NumberRT Report File Name
DateProject1SlagODWTWPS NOWIDMachine Number2014 Weld RT Report.xlsx
DateProject2AcceptODWTWPS NOWIDMachine Number2014 Weld RT Report.xlsx
DateProject3AcceptODWTWPS NOWIDMachine Number2014 Weld RT Report.xlsx
DateProject4OxidationODWTWPS NOWIDMachine Number2014 Weld RT Report.xlsx
DateProject6AcceptODWTWPS NOWIDMachine Number2014 Weld RT Report.xlsx

<tbody>
</tbody><colgroup><col><col><col><col><col span="2"><col><col><col><col></colgroup>

<tbody>
</tbody>

Option Explicit
Sub MasterDatabase()
Dim FolderPath As String
Dim FileName As String
Dim pg1 As String
Dim pg2 As String
Dim NR As Long
'Clear sheet
With Sheets("2014")
.Rows(2 & ":" & .Rows.Count).ClearContents
End With
'Change Folder Path
FolderPath = "\\mob-mdat02.no.enterdir.com\HOME_F\214613\Personal\Macro Test\"
'Change Sheetname(s)
pg1 = "Page 1"
pg2 = "Page 2"
'Change File(s)
FileName = Dir(FolderPath & "*.xl*")

Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'first joint from worksheet "Page 1"
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A8"
.Value = .Value
End With
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A23"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!J23"
If .Value = "x" Then
.Value = "Slag"
Else: .Value = "Accept"
End If
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'second joint from worksheet "Page 1"
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A26"
If .Value = "0" Then
GoTo NextPage
End If
End With
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A8"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!J26"
If .Value = "x" Then
.Value = "Slag"
Else: .Value = "Accept"
End If
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'third joint worksheet "Page 1"
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A29"
If .Value = "0" Then
GoTo NextPage
End If
End With
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A8"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!J29"
If .Value = "x" Then
.Value = "Slag"
Else: .Value = "Accept"
End If
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'fourth joint from worksheet "Page 1"
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A32"
If .Value = "0" Then
GoTo NextPage
End If
End With
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A8"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!J32"
If .Value = "x" Then
.Value = "Slag"
Else: .Value = "Accept"
End If
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'last joint from worksheet "Page 1"
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A35"
If .Value = "0" Then
GoTo NextPage
End If
End With
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!A8"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!J35"
If .Value = "x" Then
.Value = "Slag"
Else: .Value = "Accept"
End If
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg1 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With


'Goto next sheet if second, third, fourth, or last joint = 0
NextPage:


With ThisWorkbook.Sheets("2014")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'first joint from worksheet "Page 2"
With .Range("A" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!AC8"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!A8"
.Value = .Value
End With
With .Range("C" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!A23"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!AJ17"
.Value = .Value
End With
With .Range("E" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!S14"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!AA14"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!S8"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!AE23"
.Value = .Value
End With
With .Range("I" & NR)
.Formula = "='" & FolderPath & "\[" & FileName & "]" & pg2 & "'!AK8"
.Value = .Value
.Offset(, 1).Value = FileName
End With
End With

End If

FileName = Dir
Loop
End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Forum statistics

Threads
1,207,390
Messages
6,078,204
Members
446,321
Latest member
thecachingyeti

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