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
<tbody>
</tbody>
Table 2
<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
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
<tbody> </tbody><colgroup><col span="4"><col><col><col span="2"><col><col><col span="33"></colgroup> |
<tbody>
</tbody>
Table 2
<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