Private Sub ConvertData_Alpha_Click()
Dim a, b, i As Long, ii As Long, iii As Long, n As Long, myCols
With Sheets("MasterData")
myCols = Application.Match("* ALPHA", .Rows(1), 0)
If IsNumeric(myCols) Then
With .Cells(1, myCols).MergeArea
myCols = Array(.Column, .Column + .Columns.Count - 1)
End With
End If
a = .Cells(1).CurrentRegion.Value
End With
If Not IsArray(myCols) Then MsgBox "ALPHA title not found", vbCritical: Exit Sub
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 9)
For i = 3 To UBound(a, 1)
For ii = myCols(0) To myCols(1)
n = n + 1
For iii = 1 To 7
b(n, iii) = a(i, iii)
Next
b(n, 8) = a(2, ii): b(n, 9) = a(i, ii)
Next ii, i
With Sheets("ConvertedData_Alpha")
.Cells.Delete
.Cells(1).Resize(, 9).Value = Array("Unit", "Hull No", "Class", _
"Home Port", "State", "Year", "Month", "Factor", "Value")
.[a2].Resize(n, 9).Value = b
.ListObjects.Add(1, .Cells(1).CurrentRegion).Name = "Table_Convert_Alpha"
End With
End Sub
Private Sub ConvertData_BRAVO_Click()
Dim a, b, i As Long, ii As Long, iii As Long, n As Long, myCols
With Sheets("MasterData")
myCols = Application.Match("* BRAVO", .Rows(1), 0)
If IsNumeric(myCols) Then
With .Cells(1, myCols).MergeArea
myCols = Array(.Column, .Column + .Columns.Count - 1)
End With
End If
a = .Cells(1).CurrentRegion.Value
End With
If Not IsArray(myCols) Then MsgBox "BRAVO title not found", vbCritical: Exit Sub
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 9)
For i = 3 To UBound(a, 1)
For ii = myCols(0) To myCols(1)
n = n + 1
For iii = 1 To 7
b(n, iii) = a(i, iii)
Next
b(n, 8) = a(2, ii): b(n, 9) = a(i, ii)
Next ii, i
With Sheets("ConvertedData_Bravo")
.Cells.Delete
.Cells(1).Resize(, 9).Value = Array("Unit", "Hull No", "Class", _
"Home Port", "State", "Year", "Month", "Factor", "Value")
.[a2].Resize(n, 9).Value = b
.ListObjects.Add(1, .Cells(1).CurrentRegion).Name = "Table_ConvertedData_Bravo"
End With
End Sub
Private Sub ConvertData_CHARLIE_Click()
Dim a, b, i As Long, ii As Long, iii As Long, n As Long, myCols
With Sheets("MasterData")
myCols = Application.Match("* CHARLIE", .Rows(1), 0)
If IsNumeric(myCols) Then
With .Cells(1, myCols).MergeArea
myCols = Array(.Column, .Column + .Columns.Count - 1)
End With
End If
a = .Cells(1).CurrentRegion.Value
End With
If Not IsArray(myCols) Then MsgBox "CHARLIE title not found", vbCritical: Exit Sub
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 9)
For i = 3 To UBound(a, 1)
For ii = myCols(0) To myCols(1)
n = n + 1
For iii = 1 To 7
b(n, iii) = a(i, iii)
Next
b(n, 8) = a(2, ii): b(n, 9) = a(i, ii)
Next ii, i
With Sheets("ConvertedData_Charlie")
.Cells.Delete
.Cells(1).Resize(, 9).Value = Array("Unit", "Hull No", "Class", _
"Home Port", "State", "Year", "Month", "Factor", "Value")
.[a2].Resize(n, 9).Value = b
.ListObjects.Add(1, .Cells(1).CurrentRegion).Name = "Table_ConvertedData_Charlie"
End With
End Sub
Here, I've copied the same function now 3 times and replaced the "Alpha", "Bravo", and "Charlie" references where necessary. As you know, when each function is executed, I'm now creating 3 separate tabs based on the master data.
Bookmarks