# VBA 模組原始碼
# 來源：全機型_日報表.xlsm
# 提取工具：olevba 0.60.2
# 提取時間：2026-04-07

---

## Module19.bas - NT()

```vba
Function NT(Number As Integer) As String
    NT = Split(Cells(1, Number).Address, "$")(1)
End Function
```

---

## Module7.bas - ra()

```vba
Function ra(inputText As String) As String
    Dim regEx As Object
    Dim matches As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .pattern = "[A-Z0-9-]{6,25}"
        .Global = True
    End With
    
    Set matches = regEx.Execute(inputText)
    
    If matches.Count > 0 Then
        ra = matches(0).Value
    Else
        ra = "NO"
    End If
End Function
```

---

## Module5.bas - A()

```vba
Sub A()
    Call B
    Call Q
End Sub
```

---

## Module6.bas - B()

```vba
Sub B()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Dim wsFocest As Worksheet, wsBOM As Worksheet, wsOutput As Worksheet, wsUnmatched As Worksheet
    Dim lastRowF As Long, lastRowB As Long, lastRowO As Long, lastRowU As Long
    Dim i As Long, j As Long, k As Long, col As Long
    Dim keyPart As String, material As String, usage As Double
    Dim lic As Double, focestCol1 As String, focestCol2 As String
    Dim weekValues(1 To 56) As Double
    Dim dictBOM As Object, dictUnmatched As Object
    Dim materialData As Variant
    Dim key As Variant
    
    Set dictBOM = CreateObject("Scripting.Dictionary")
    Set dictUnmatched = CreateObject("Scripting.Dictionary")
    
    ' Set worksheets
    Set wsFocest = ThisWorkbook.Sheets("FCST")
    Set wsBOM = ThisWorkbook.Sheets("BOM")
    
    ' Create new worksheets for output
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Output").Delete
    ThisWorkbook.Sheets("Unmatched").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set wsOutput = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsOutput.Name = "Output"
    Set wsUnmatched = ThisWorkbook.Sheets.Add(After:=wsOutput)
    wsUnmatched.Name = "Unmatched"
    
    ' Phase 1: Read BOM data into dictionary
    lastRowB = wsBOM.Cells(wsBOM.Rows.Count, "A").End(xlUp).Row
    Dim bomData As Variant
    bomData = wsBOM.Range("A2:C" & lastRowB).Value
    
    For i = 1 To UBound(bomData, 1)
        keyPart = Trim(bomData(i, 1) & "")
        material = Trim(bomData(i, 2) & "")
        
        ' Safe handling of usage value
        If IsNumeric(bomData(i, 3)) Then
            usage = CDbl(bomData(i, 3))
        Else
            usage = 0
        End If
        
        If keyPart <> "" And material <> "" Then
            If Not dictBOM.exists(keyPart) Then
                dictBOM.Add keyPart, New Collection
            End If
            dictBOM(keyPart).Add Array(material, usage)
        End If
    Next i
    
    ' Phase 2: Process Focest data - only process rows with BOM matches
    lastRowF = wsFocest.Cells(wsFocest.Rows.Count, "A").End(xlUp).Row
    Dim focestData As Variant
    focestData = wsFocest.Range("A2:BJ" & lastRowF).Value ' Columns A to BJ (A, B + 56 weeks)
    
    ' Pre-calculate output data size
    Dim outputRowCount As Long
    outputRowCount = 0
    For i = 1 To UBound(focestData, 1)
        keyPart = Trim(focestData(i, 1) & "")
        If keyPart <> "" And dictBOM.exists(keyPart) Then
            outputRowCount = outputRowCount + dictBOM(keyPart).Count
        End If
    Next i
    
    ' Prepare output array
    Dim outputData() As Variant
    ReDim outputData(1 To outputRowCount, 1 To 60) ' 4 fixed columns + 56 week columns
    
    lastRowO = 0
    
    For i = 1 To UBound(focestData, 1)
        keyPart = Trim(focestData(i, 1) & "")
        If keyPart = "" Then GoTo NextFocestRow
        
        ' Only process rows with BOM matches
        If dictBOM.exists(keyPart) Then
            focestCol1 = focestData(i, 1) & ""
            focestCol2 = focestData(i, 2) & ""
            
            ' Safe handling of LIC value
            If IsNumeric(focestData(i, 2)) Then
                lic = CDbl(focestData(i, 2))
            Else
                lic = 0
            End If
            
            ' Extract week values with error handling
            For j = 1 To 56
                If IsNumeric(focestData(i, j + 2)) Then
                    weekValues(j) = CDbl(focestData(i, j + 2))
                Else
                    weekValues(j) = 0
                End If
            Next j
            
            ' Process matching BOM items
            For k = 1 To dictBOM(keyPart).Count
                materialData = dictBOM(keyPart)(k)
                material = materialData(0)
                usage = materialData(1)
                lastRowO = lastRowO + 1
                
                outputData(lastRowO, 1) = focestCol1
                outputData(lastRowO, 2) = focestCol2
                outputData(lastRowO, 3) = material
                outputData(lastRowO, 4) = usage
                
                For col = 1 To 56
                    outputData(lastRowO, col + 4) = weekValues(col) * lic * usage
                Next col
            Next k
        End If
        
NextFocestRow:
    Next i
    
    ' Phase 3: Separately process Focest rows without BOM matches
    For i = 1 To UBound(focestData, 1)
        keyPart = Trim(focestData(i, 1) & "")
        If keyPart <> "" And Not dictBOM.exists(keyPart) Then
            If Not dictUnmatched.exists(keyPart) Then
                dictUnmatched.Add keyPart, True
            End If
        End If
    Next i
    
    ' Batch write output data
    If outputRowCount > 0 Then
        wsOutput.Range("A2").Resize(outputRowCount, 60).Value = outputData
    End If
    
    ' Generate unmatched sheet
    wsUnmatched.Cells(1, 1).Value = "Unmatched Key Part Numbers"
    
    If dictUnmatched.Count > 0 Then
        Dim unmatchedData() As Variant
        ReDim unmatchedData(1 To dictUnmatched.Count, 1 To 1)
        i = 0
        For Each key In dictUnmatched.Keys
            i = i + 1
            unmatchedData(i, 1) = key
        Next key
        wsUnmatched.Range("A2").Resize(dictUnmatched.Count, 1).Value = unmatchedData
    End If
    
    ' Set headers
    wsOutput.Cells(1, 1).Value = "Focest Col1"
    wsOutput.Cells(1, 2).Value = "Focest Col2"
    wsOutput.Cells(1, 3).Value = "Material Number"
    wsOutput.Cells(1, 4).Value = "BOM Usage"
    For col = 1 To 56
        wsOutput.Cells(1, col + 4).Value = "Week" & col
    Next col
    
    ' Auto-fit columns
    wsOutput.Columns.AutoFit
    wsUnmatched.Columns.AutoFit
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "Processing completed! " & outputRowCount & " rows generated in Output sheet. " & _
           dictUnmatched.Count & " unmatched items found."
End Sub
```

---

## Module3.bas - Q()

```vba
Sub Q()
' Define variables
Dim wsSource As Worksheet, wsDest As Worksheet
Dim pvtCache As PivotCache
Dim pvtTable As PivotTable
Dim lastRow As Long
Dim SourceDataRange As Range
Dim i As Long
Dim fieldName As String
Dim startTime As Double
Dim dataField As PivotField

' Start timing execution
startTime = Timer

' Disable Excel features for performance optimization
OptimizeVBA True

On Error GoTo ErrorHandler

' Check if source worksheet exists
If Not WorksheetExists("Output") Then
    MsgBox "Source worksheet 'Output' not found!", vbCritical
    GoTo CleanUp
End If

' Set reference to source worksheet
Set wsSource = ThisWorkbook.Worksheets("Output")

' Delete destination worksheet if it already exists
If WorksheetExists("Cutout") Then
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Cutout").Delete
    Application.DisplayAlerts = True
End If

' Remove any existing pivot table with the same name
RemovePivotTable "WeeklySummaryPivot"

' Create new worksheet for the pivot table
Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsDest.Name = "Cutout"

' Find the last row with data in source worksheet - MORE ROBUST METHOD
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
If lastRow = 1 And wsSource.Cells(1, 1).Value = "" Then lastRow = 0

' Verify there is sufficient data
If lastRow < 2 Then
    MsgBox "Insufficient data in source worksheet!", vbExclamation
    GoTo CleanUp
End If

' Define source data range
Set SourceDataRange = wsSource.Range("A1:BH" & lastRow)

' Create pivot cache from source data
Set pvtCache = ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SourceDataRange.Address(ReferenceStyle:=xlR1C1, External:=True))

Set pvtTable = pvtCache.CreatePivotTable( _
    TableDestination:=wsDest.Range("A3"), _
    tableName:="WeeklySummaryPivot")

With pvtTable
    .ManualUpdate = True
    .RowAxisLayout xlTabularRow
    
    ' Add row field - Material Number (Column C)
    .PivotFields(wsSource.Cells(1, 3).Value).Orientation = xlRowField
    
    ' Add data fields (columns E to BH) - WITH PERFORMANCE CHECK
    For i = 5 To 60
        fieldName = wsSource.Cells(1, i).Value
        
        ' Only add field if it has a name and is likely numeric (avoid text fields for sum)
        If fieldName <> "" Then
            On Error Resume Next
            Set dataField = .PivotFields(fieldName)
            If Err.Number = 0 Then
                With dataField
                    .Orientation = xlDataField
                    .Function = xlSum
                    .NumberFormat = "#,##0"
                    ' Only rename if not already renamed
                    If InStr(1, .Caption, "Sum of", vbTextCompare) = 0 Then
                        .Caption = "Sum of " & fieldName
                    End If
                End With
            Else
                Err.Clear
            End If
            On Error GoTo ErrorHandler
        End If
    Next i
    
    ' Apply formatting
    .ShowTableStyleRowStripes = True
    On Error Resume Next
    .TableStyle2 = "PivotStyleMedium9"
    If Err.Number <> 0 Then
        .TableStyle1 = "PivotStyleMedium9"
        Err.Clear
    End If
    On Error GoTo ErrorHandler
    .ManualUpdate = False
End With

' Add title and timestamp
With wsDest
    .Range("A1").Value = "Weekly Summary Report"
    .Range("A1").Font.Bold = True
    .Range("A1").Font.Size = 14
    
    .Range("A2").Value = "Generated: " & Now()
    .Range("A2").Font.Italic = True
End With

' Auto-fit columns carefully for large datasets
Application.ScreenUpdating = False
wsDest.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True

' Success message
MsgBox "Pivot table created successfully in " & Format(Timer - startTime, "0.00") & _
       " seconds! Location: Worksheet " & wsDest.Name, vbInformation

CleanUp:
OptimizeVBA False
Set pvtTable = Nothing
Set pvtCache = Nothing
Set SourceDataRange = Nothing
Set wsSource = Nothing
Set wsDest = Nothing

Exit Sub

ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
"Please ensure your data in 'Output' sheet is correctly formatted.", vbCritical
Resume CleanUp
End Sub

' Helper function: Optimize VBA performance
Sub OptimizeVBA(Optimize As Boolean)
With Application
    If Optimize Then
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    .EnableEvents = False
    .StatusBar = "Processing... Please wait"
    Else
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    .EnableEvents = True
    .StatusBar = False
    End If
End With
End Sub

' Helper function: Check if worksheet exists
Function WorksheetExists(sheetName As String) As Boolean
On Error Resume Next
WorksheetExists = Not ThisWorkbook.Sheets(sheetName) Is Nothing
On Error GoTo 0
End Function

' Helper function: Remove pivot table by name (FIXED For Each issue)
Sub RemovePivotTable(tableName As String)
Dim ws As Worksheet
Dim pt As PivotTable

On Error Resume Next

For Each ws In ThisWorkbook.Worksheets
    ' CRITICAL FIX: Check if the worksheet has any pivot tables before trying to access one by name
    If ws.PivotTables.Count > 0 Then
        Set pt = ws.PivotTables(tableName)
        If Not pt Is Nothing Then
            pt.TableRange2.Clear
            Exit For
        End If
    End If
Next ws

On Error GoTo 0
End Sub
```

---

## Module20.bas - W()

```vba
Sub W()
    ' =========================================================================
    ' USER CONFIGURATION AREA - Modify parameters below
    ' =========================================================================
    
    ' Data source settings
    Const SOURCE_SHEET As String = "KCB"           ' Source worksheet name
    Const PIVOT_SHEET_NAME As String = "MaterialSummary"  ' Output pivot table sheet name
    Const HEADER_ROW As Long = 1                   ' Header row number
    
    ' Custom column settings
    Dim CUSTOM_COLUMNS As Variant
    CUSTOM_COLUMNS = Array("B", "C", "D", "E", "F", "G", "H", "I", "J")  ' Columns to include
    
    ' Pivot table field settings
    Const ROW_FIELD_COLUMN As String = "B"         ' Row field (row labels) column
    Dim DATA_FIELDS As Variant
    DATA_FIELDS = Array("C", "D", "E", "F", "G", "H")                  ' Data field columns to summarize
    
    ' Performance optimization settings
    Const USE_ARRAY_METHOD As Boolean = False      ' Disable array method to avoid 1004 errors
    
    ' Output settings
    Const SHOW_PERFORMANCE_STATS As Boolean = True ' Show performance statistics
    Const AUTO_ADJUST_COLUMNS As Boolean = True    ' Auto-adjust column widths
    
    ' =========================================================================
    ' MAIN PROGRAM - Code below generally doesn't need modification
    ' =========================================================================
    
    Dim startTime As Double
    If SHOW_PERFORMANCE_STATS Then startTime = Timer
    
    Dim wsData As Worksheet, wsPivot As Worksheet
    Dim rngData As Range
    Dim lastRow As Long, lastCol As Long
    
    ' Performance optimization settings
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.StatusBar = "Preparing data..."
    
    On Error GoTo ErrorHandler
    
    ' Check if source sheet exists
    If Not WorksheetExists(SOURCE_SHEET) Then
        MsgBox "Source worksheet '" & SOURCE_SHEET & "' not found!", vbExclamation
        GoTo CleanUp
    End If
    
    ' Set source worksheet
    Set wsData = ThisWorkbook.Worksheets(SOURCE_SHEET)
    
    ' Get data range
    With wsData
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lastCol = .Cells(HEADER_ROW, .Columns.Count).End(xlToLeft).Column
        
        If lastRow <= HEADER_ROW Then
            MsgBox "No data found in worksheet!", vbExclamation
            GoTo CleanUp
        End If
        
        Application.StatusBar = "Reading data (" & lastRow & " rows)..."
        
        ' Build data range
        Set rngData = BuildSafeRange(wsData, HEADER_ROW, lastRow, CUSTOM_COLUMNS)
        
        If rngData Is Nothing Then
            MsgBox "Failed to create data range. Please check column references.", vbExclamation
            GoTo CleanUp
        End If
        
        If rngData.Rows.Count <= 1 Then
            MsgBox "No data rows found after applying column filters.", vbExclamation
            GoTo CleanUp
        End If
    End With
    
    ' Delete existing worksheet
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(PIVOT_SHEET_NAME).Delete
    On Error GoTo ErrorHandler
    Application.DisplayAlerts = True
    
    ' Create new worksheet
    Application.StatusBar = "Creating pivot table..."
    Set wsPivot = ThisWorkbook.Worksheets.Add
    wsPivot.Name = PIVOT_SHEET_NAME
    
    ' Create pivot table (now uses DATA_FIELDS setting)
    CreatePivotTableWithDataFields wsPivot, rngData, ROW_FIELD_COLUMN, DATA_FIELDS, wsData, HEADER_ROW
    
    ' Apply formatting
    Application.StatusBar = "Applying formatting..."
    With wsPivot
        .Range("A1").Value = "Material Summary"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = 14
        
        If AUTO_ADJUST_COLUMNS Then
            .Columns.AutoFit
        End If
        
        .Range("A2").Value = "Created: " & Now()
        .Range("A2").Font.Italic = True
        .Range("A2").Font.Color = RGB(100, 100, 100)
    End With
    
    ' Show results
    Application.StatusBar = False
    
    If SHOW_PERFORMANCE_STATS Then
        Dim endTime As Double, elapsedTime As Double
        endTime = Timer
        elapsedTime = endTime - startTime
        
        MsgBox "Pivot table created successfully!" & vbCrLf & _
               "Data rows: " & (lastRow - HEADER_ROW) & vbCrLf & _
               "Columns included: " & (UBound(CUSTOM_COLUMNS) - LBound(CUSTOM_COLUMNS) + 1) & vbCrLf & _
               "Data fields: " & Join(DATA_FIELDS, ", ") & vbCrLf & _
               "Processing time: " & Format(elapsedTime, "0.00") & " seconds", vbInformation
    Else
        MsgBox "Pivot table created successfully!", vbInformation
    End If
    
CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.StatusBar = False
    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
           "Please check your configuration settings and data structure.", vbCritical
    GoTo CleanUp
End Sub

' =========================================================================
' Fixed pivot table creation function - Now correctly uses DATA_FIELDS setting
' =========================================================================

Sub CreatePivotTableWithDataFields(wsPivot As Worksheet, rngData As Range, rowFieldCol As String, dataFields As Variant, wsData As Worksheet, headerRow As Long)
    ' Purpose: Create pivot table using configured data fields
    
    On Error GoTo ErrorHandler
    
    Dim pc As PivotCache, pt As PivotTable
    Dim i As Long, fieldIndex As Long
    Dim rowFieldTitle As String, dataFieldTitle As String
    Dim colIndex As Long
    
    ' Validate data range
    If rngData Is Nothing Then
        MsgBox "Data range is empty. Cannot create pivot table.", vbExclamation
        Exit Sub
    End If
    
    If rngData.Rows.Count <= 1 Then
        MsgBox "Not enough data rows for pivot table.", vbExclamation
        Exit Sub
    End If
    
    ' Create pivot cache
    Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData)
    
    ' Create pivot table
    Set pt = pc.CreatePivotTable(TableDestination:=wsPivot.Range("A3"), tableName:="CustomPivot")
    
    With pt
        ' Add row field (using configured row field column)
        colIndex = GetColumnIndex(rowFieldCol)
        If colIndex > 0 Then
            rowFieldTitle = wsData.Cells(headerRow, colIndex).Value
            .PivotFields(rowFieldTitle).Orientation = xlRowField
        Else
            ' If row field is invalid, use first column as default row field
            .PivotFields(1).Orientation = xlRowField
        End If
        
        ' Add data fields (using configured data fields)
        For i = LBound(dataFields) To UBound(dataFields)
            colIndex = GetColumnIndex(dataFields(i))
            If colIndex > 0 Then
                dataFieldTitle = wsData.Cells(headerRow, colIndex).Value
                On Error Resume Next ' Skip fields that cannot be added
                .AddDataField .PivotFields(dataFieldTitle), "Sum of " & dataFieldTitle, xlSum
                On Error GoTo ErrorHandler
            End If
        Next i
        
        ' If no data fields were successfully added, add all numeric fields as fallback
        If .dataFields.Count = 0 Then
            MsgBox "Configured data fields are invalid. Adding all numeric fields.", vbExclamation
            For i = 2 To .PivotFields.Count
                On Error Resume Next
                .AddDataField .PivotFields(i), "Sum of " & .PivotFields(i).Name, xlSum
                On Error GoTo ErrorHandler
            Next i
        End If
        
        ' Apply style
        On Error Resume Next
        .TableStyle2 = "PivotStyleLight16"
        .RowAxisLayout xlTabularRow
        On Error GoTo ErrorHandler
    End With
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Error creating pivot table: " & Err.Description, vbExclamation
End Sub

' =========================================================================
' Helper functions
' =========================================================================

Function BuildSafeRange(ws As Worksheet, headerRow As Long, lastRow As Long, customCols As Variant) As Range
    ' Purpose: Safely build data range
    
    On Error GoTo ErrorHandler
    
    Dim firstCol As Long, lastCol As Long
    Dim colIndex As Long, i As Long
    
    ' Validate custom column references
    For i = LBound(customCols) To UBound(customCols)
        colIndex = GetColumnIndex(customCols(i))
        If colIndex < 1 Or colIndex > ws.Columns.Count Then
            MsgBox "Invalid column reference: " & customCols(i), vbExclamation
            Set BuildSafeRange = Nothing
            Exit Function
        End If
    Next i
    
    firstCol = GetColumnIndex(customCols(LBound(customCols)))
    lastCol = GetColumnIndex(customCols(UBound(customCols)))
    
    If headerRow > lastRow Then
        MsgBox "Header row is after last data row!", vbExclamation
        Set BuildSafeRange = Nothing
        Exit Function
    End If
    
    Set BuildSafeRange = ws.Range(ws.Cells(headerRow, firstCol), ws.Cells(lastRow, lastCol))
    
    If BuildSafeRange Is Nothing Then
        MsgBox "Failed to create data range.", vbExclamation
        Exit Function
    End If
    
    Exit Function
    
ErrorHandler:
    MsgBox "Error in BuildSafeRange: " & Err.Description, vbExclamation
    Set BuildSafeRange = Nothing
End Function

Function GetColumnIndex(col As Variant) As Long
    ' Purpose: Convert column letter to column index
    
    On Error GoTo ErrorHandler
    
    If VarType(col) = vbString Then
        GetColumnIndex = Range(col & "1").Column
    Else
        GetColumnIndex = col
    End If
    
    Exit Function
    
ErrorHandler:
    GetColumnIndex = 0
End Function

Function WorksheetExists(sheetName As String) As Boolean
    ' Purpose: Check if worksheet exists
    
    On Error Resume Next
    WorksheetExists = Not ThisWorkbook.Worksheets(sheetName) Is Nothing
    On Error GoTo 0
End Function

' =========================================================================
' Diagnostic tools
' =========================================================================

Sub CheckDataFields()
    ' Purpose: Check if data field configuration is correct
    
    Dim wsData As Worksheet
    Dim dataField As Variant
    Dim colIndex As Long
    Dim result As String
    
    Set wsData = ThisWorkbook.Worksheets("KCB")
    
    result = "Data Fields Check:" & vbCrLf & vbCrLf
    
    For Each dataField In Array("C", "E")  ' Using configured DATA_FIELDS
        colIndex = GetColumnIndex(dataField)
        If colIndex > 0 Then
            result = result & "Column " & dataField & ": Valid" & vbCrLf & _
                     "  Index: " & colIndex & vbCrLf & _
                     "  Title: '" & wsData.Cells(1, colIndex).Value & "'" & vbCrLf & vbCrLf
        Else
            result = result & "Column " & dataField & ": Invalid" & vbCrLf & vbCrLf
        End If
    Next dataField
    
    MsgBox result, vbInformation, "Data Fields Check"
End Sub

' =========================================================================
' Simple version - Use if above code still has issues
' =========================================================================

Sub SimplePivotTable()
    ' Very simple version to avoid 1004 errors
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    On Error GoTo ErrorHandler
    
    Dim wsData As Worksheet, wsPivot As Worksheet
    Dim rngData As Range
    Dim lastRow As Long
    
    ' Configuration - modify as needed
    Const SOURCE_SHEET As String = "KCB"
    Const PIVOT_SHEET_NAME As String = "SimpleSummary"
    
    ' Check if source exists
    If Not WorksheetExists(SOURCE_SHEET) Then
        MsgBox "Worksheet '" & SOURCE_SHEET & "' not found!", vbExclamation
        GoTo CleanUp
    End If
    
    Set wsData = ThisWorkbook.Worksheets(SOURCE_SHEET)
    
    ' Find last row in column B (material column)
    lastRow = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row
    
    If lastRow <= 1 Then
        MsgBox "No data found!", vbExclamation
        GoTo CleanUp
    End If
    
    ' Use simple range (columns B to I)
    Set rngData = wsData.Range("B1:I" & lastRow)
    
    ' Delete existing sheet
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(PIVOT_SHEET_NAME).Delete
    On Error GoTo ErrorHandler
    Application.DisplayAlerts = True
    
    ' Create pivot table using simple method
    Set wsPivot = ThisWorkbook.Worksheets.Add
    wsPivot.Name = PIVOT_SHEET_NAME
    
    ' This method is less likely to cause 1004 errors
    wsPivot.Activate
    Set rngData = wsData.Range("B1:I" & lastRow)
    
    ' Use PivotTableWizard to create pivot table
    Set pt = wsPivot.PivotTableWizard(SourceType:=xlDatabase, _
                                     SourceData:=rngData, _
                                     TableDestination:=wsPivot.Range("A3"))
    
    ' Simple configuration
    With pt
        .PivotFields(wsData.Range("B1").Value).Orientation = xlRowField
        .PivotFields(wsData.Range("E1").Value).Orientation = xlDataField
        .PivotFields(wsData.Range("H1").Value).Orientation = xlDataField
        .PivotFields(wsData.Range("I1").Value).Orientation = xlDataField
    End With
    
    ' Simple formatting
    wsPivot.Range("A1").Value = "Simple Material Summary"
    wsPivot.Columns.AutoFit
    
    MsgBox "Simple pivot table created successfully!", vbInformation
    
CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
    GoTo CleanUp
End Sub

Sub CheckDataRange()
    ' Purpose: Check data range to help diagnose issues
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long, lastCol As Long
    
    Set ws = ThisWorkbook.Worksheets("KCB")
    
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    MsgBox "Data Check:" & vbCrLf & _
           "Last row: " & lastRow & vbCrLf & _
           "Last column: " & lastCol & vbCrLf & _
           "Header row data: " & ws.Range("A1").Value & "..." & ws.Cells(1, lastCol).Value, _
           vbInformation, "Data Diagnostic"
    
    ' Show a sample of the data
    If lastRow > 1 Then
        Set rng = ws.Range("A1").Resize(2, lastCol)
        rng.Select
    End If
End Sub
```

---

## Module21.bas - MKey()

```vba
Sub MKey()
    ' Declare variables
    Dim wsBOM As Worksheet
    Dim wsTarget As Worksheet
    Dim dict As Object
    Dim lastRowBOM As Long
    Dim lastRowTarget As Long
    Dim i As Long
    Dim primaryKey As String
    Dim model As String
    Dim modelKey As String
    Dim dataArray As Variant
    Dim resultArray() As String
    Dim modelArray() As String
    Dim j As Long
    Dim isDuplicate As Boolean
    Dim foundKeys As Object
    Dim originalColumnWidth As Double
    
    ' Save original column B width
    On Error Resume Next
    originalColumnWidth = Worksheets("0000").Columns("B").Width
    On Error GoTo 0
    
    ' Turn off screen updating and calculation for speed
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo ErrorHandler
    
    ' Set worksheets
    On Error Resume Next
    Set wsBOM = Worksheets("BOM_BUFFER")
    Set wsTarget = Worksheets("0000")
    On Error GoTo ErrorHandler
    
    If wsBOM Is Nothing Then
        MsgBox "Worksheet 'BOM' not found!", vbExclamation
        GoTo CleanUp
    End If
    
    If wsTarget Is Nothing Then
        MsgBox "Worksheet '0000' not found!", vbExclamation
        GoTo CleanUp
    End If
    
    ' Create dictionaries for faster lookup
    Set dict = CreateObject("Scripting.Dictionary")
    Set foundKeys = CreateObject("Scripting.Dictionary")
    
    ' Get data from BOM sheet (A=model, B=primary key) starting from row 3
    lastRowBOM = wsBOM.Cells(wsBOM.Rows.Count, "A").End(xlUp).Row
    If lastRowBOM < 3 Then
        MsgBox "No data found in BOM sheet (data should start from row 3)!", vbExclamation
        GoTo CleanUp
    End If
    
    dataArray = wsBOM.Range("A3:B" & lastRowBOM).Value
    
    ' Build dictionary from BOM data (group models by primary key)
    For i = 1 To UBound(dataArray, 1)
        model = Trim(CStr(dataArray(i, 1)))    ' Column A - model data
        primaryKey = Trim(CStr(dataArray(i, 2))) ' Column B - primary key
        
        ' Validate data
        If primaryKey <> "" And model <> "" Then
            ' MODIFIED: For models starting with "781" - keep first 9 characters
            If Left(model, 3) = "781" Then
                If Len(model) >= 9 Then
                    modelKey = Left(model, 9)  ' Keep first 9 characters for 781 starting models
                Else
                    modelKey = model  ' If less than 9 chars, keep original
                End If
            Else
                ' Extract first 7 characters for other models
                If Len(model) >= 7 Then
                    modelKey = Left(model, 7)
                Else
                    modelKey = model
                End If
            End If
            
            ' Process by primary key
            If dict.exists(primaryKey) Then
                ' Split existing models and check for duplicates
                modelArray = Split(dict(primaryKey), ",")
                isDuplicate = False
                
                ' Check if modelKey already exists for this primary key
                For j = 0 To UBound(modelArray)
                    If Trim(modelArray(j)) = modelKey Then
                        isDuplicate = True
                        Exit For
                    End If
                Next j
                
                ' Add only if not duplicate
                If Not isDuplicate Then
                    dict(primaryKey) = dict(primaryKey) & "," & modelKey
                End If
            Else
                ' First entry for this primary key
                dict(primaryKey) = modelKey
            End If
        End If
    Next i
    
    ' Get target range from 0000 sheet (column A = primary keys) starting from row 3
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    If lastRowTarget < 3 Then
        MsgBox "No primary keys found in 0000 sheet (data should start from row 3)!", vbExclamation
        GoTo CleanUp
    End If
    
    ' Prepare result array for column B starting from row 3
    ReDim resultArray(1 To lastRowTarget - 2, 1 To 1)
    
    ' Match models to primary keys - using direct cell reference instead of range variable
    For i = 3 To lastRowTarget
        primaryKey = Trim(CStr(wsTarget.Cells(i, 1).Value))
        
        If primaryKey <> "" Then
            If dict.exists(primaryKey) Then
                resultArray(i - 2, 1) = Replace(dict(primaryKey), ",", ", ")
                foundKeys(primaryKey) = True
            Else
                resultArray(i - 2, 1) = "Not Found"
            End If
        Else
            resultArray(i - 2, 1) = ""
        End If
    Next i
    
    ' Insert results into column B of 0000 sheet starting from row 3
    wsTarget.Range("B3:B" & lastRowTarget).Value = resultArray
    
    ' Restore original column width instead of auto-fit
    wsTarget.Columns("B").Width = originalColumnWidth
    
    ' Show