Sub Brand(V)
Dim X, R&, S$()
X = Application.VLookup(ActiveSheet.UsedRange.Columns(3), Worksheet____1.[A1].CurrentRegion, 2, False)
For R = 2 To UBound(X)
If Not IsError(X(R, 1)) Then
S = Split(V(R, 1))
If S(UBound(S)) <> X(R, 1) Then _
If IsError(Application.Match(S(UBound(S)), Worksheet____1.[A1].CurrentRegion.Columns(2), 0)) Then _
V(R, 1) = V(R, 1) & " " & X(R, 1) Else S(UBound(S)) = X(R, 1): V(R, 1) = Join(S)
End If
Next
ActiveSheet.UsedRange.Columns(2) = V
End Sub
Sub SplitAndArrange()
Const M = 31
Dim V, K, F, N, R&, W, L&, E&
Worksheet____1.[E1].CurrentRegion.Clear
With Application
V = Array([{"BRAND","Purchase Order","Sr"}], .Index(UsedRange.Rows(1), 1, [{8,5,3,2,6,7}]), _
.Index(UsedRange.Rows(1), 1, [{2,4,6}]), .Index(UsedRange.Rows(1), 1, [{5,4,2,3}]), ["TableStyleMedium"&{2,3,6}])
.DisplayAlerts = False
.ScreenUpdating = False
If Worksheets.Count > Index Then _
Worksheets(Evaluate("COLUMN(" & Cells(Index + 1).Resize(, Worksheets.Count - Index).Address & ")")).Delete
UsedRange.Columns(1).AdvancedFilter 2, , [FC1], True
K = [FC1].CurrentRegion
F = .Match(K, UsedRange.Columns(1), 0): F(2, 1) = 1
N = .Substitute(K, ".pdf", "")
For R = 2 To UBound(F)
W = .Match(Cells(F(R, 1), 5), V(0), 0)
L = Len(N(R, 1))
If L <= M And IsNumeric(W) Then
[FC2] = K(R, 1)
With Sheets.Add(, Sheets(Sheets.Count))
.Name = N(R, 1)
With .[A1].Resize(, UBound(V(W))): .Value = V(W): UsedRange.AdvancedFilter 2, [FC1:FC2], .Cells: End With
If F(R, 1) > 2 Then .Rows(1).Delete
If W = 1 Then
Brand Application.Trim(.Evaluate(.UsedRange.Columns(2).Address & "&"" ""&" & _
.UsedRange.Columns(5).Address & "&"" ""&" & .UsedRange.Columns(6).Address))
.[A1:B1] = Array(V(0)(3), V(0)(1))
.UsedRange.Columns("E:F").Clear
ElseIf W = 2 Then
.Range("B2:B" & .UsedRange.Rows.Count) = .Evaluate("B2:B" & .UsedRange.Rows.Count & "&"" JAP""")
.UsedRange.Columns(3).Replace " Unit", "", 2
Else
Brand .UsedRange.Columns(2).Value
End If
.UsedRange.Borders.LineStyle = xlNone
.UsedRange.HorizontalAlignment = xlCenter
.UsedRange.Interior.ColorIndex = xlNone
.UsedRange.WrapText = False
.ListObjects.Add(1, .UsedRange, , 1).TableStyle = V(4)(W)
.UsedRange.Columns("B:C").AutoFit
If .UsedRange.Rows.Count >= ActiveWindow.VisibleRange.Rows.Count Then _
ActiveWindow.SplitRow = 1: ActiveWindow.FreezePanes = True
End With
Else
E = E + 1
Worksheet____1.Rows(E).Columns("E:F") = Array(IIf(L > M, L, "?"), N(R, 1))
End If
Next
[FC1].CurrentRegion.Clear
.DisplayAlerts = True
.ScreenUpdating = True
End With
If E Then
Worksheet____1.[E1].CurrentRegion.Columns(1).HorizontalAlignment = xlCenter
Worksheet____1.Activate
MsgBox E, 48, "Rejected"
End If
End Sub
Bookmarks