Update Master Data with Excel by Calling RFCs

In rare cases, access to transactions to perform mass loads or to affect changes to data with any significant volume are restricted for users--even for users who are responsible for maintaining Master Data. One option is to use Excel to create an OLE connection to the SAPGUI interface to run scripts, but that option requires scripting to be turned on in the SAP system and each record takes several seconds to call a transaction and run it to completion in foreground.

Another option is to use run BAPIs from Excel using Remote Function Calls (RFCs) to perform the updates. This option is more cumbersome than transactions designed by SAP to perform mass updates and it requires that the user performing the updates have RFC access, but it is faster than using Excel for scripting and more accurate than manually keying data.

One commonly-used function performed via RFC is RFC_READ_TABLE. This function returns data from tables in SAP that can be used to import table data into Access or to populate Excel spreadsheets with table data from SAP.

In the sample code below, the RFC_READ_TABLE function is called to populate spreadsheets with data from the DD03L table and from various check tables. This data is then combined with the source data to populate the parameters that are then passed into the BAPI. In this sample, the BAPI_MATERIAL_SAVEDATA function is used to update Plant extensions along with the associated Valuation data.

Step 1: Validating the source data and preparing load data

This code knits the source data together with the data from DD03L to determine which of the esoteric fields in the structures will be populated with data to load. The combined data is then compared against the data from the MARC table and the T032F table to pick a View in the Material Master Plant extension to update.

If the Material Master does not exist or is not extended to the Plant wherein the update is to be performed then the code will catch that instead of relying on the BAPI to return an error. Additionally, if the Material Master is not extended to a View that has the field to be populated then the code will identify that problem instead of trying to call the BAPI with no View to update.

This code does not validate values to be loaded in fields before calling the BAPI. Invalid values will be mentioned in the log entry after the BAPI runs and fails to update a Plant extension.

Sub PrepareRFC()
    Dim R3 As Object, nCurrent As Long, nCurrentColumn As Long, strTabName As String
    Dim nCurrentField As Long, strCurrentField As String, nCurrentTranslate As Long
    Dim strPSTAT As String, strTempPSTAT As String, nCountMARA As Long, isProblem As Boolean
    Dim strMATNR As String, strWERKS As String, strFieldName As String
    Dim nCurSec As Integer, strRange As String, nCurrentPlant As Long
    Dim wsInput As Worksheet, dStart As Date
    
    dStart = Now 'Report how long this takes.
    
    Set wsInput = CreateTab("MARA")
    Set wsInput = CreateTab("MARC")
    Set wsInput = Nothing
    
    Dim wsHEADDATA As Worksheet, wsPLANTDATA As Worksheet, wsVALUATIONDATA As Worksheet
    Dim wsPLANTDATAX As Worksheet, wsVALUATIONDATAX As Worksheet

    a = ActivatePlantMagicTab

    If Not GetR3(R3) Then
        Exit Sub
    End If
    
    a = SAP_RFC_READ_TABLE(R3, "T130F", "tblT130F", "")
    a = SAP_RFC_READ_TABLE(R3, "T132", "tblT132", "")
    nCurrent = SAP_RFC_READ_TABLE(R3, "DD03L", "tblDD03L", "", "TABNAME in ('BAPI_MARC','BAPI_MBEW','BAPIMATHEAD','MARC','MBEW')")
    Call SortDD03L(nCurrent)
    
    a = CreateLogEntry("Finished pulling check tables.")
    
    For nCurrent = 2 To 1048576
        If Range("B" & nCurrent).Value <> "" Then
            Range("B" & nCurrent & ":C" & nCurrent).NumberFormat = "@"
            Range("B" & nCurrent & ":V" & nCurrent).Interior.Color = xlNone
            Range("B" & nCurrent).Value = Right("0000000000" & Trim(UCase(Range("B" & nCurrent).Value)), 18)
            Range("C" & nCurrent).Value = Trim(UCase(Range("C" & nCurrent).Value))
        End If
    Next

    nCountMARA = PopulateMARA(R3, Sheets("PlantUpdateRFC").Range("B:B"))
    a = CreateLogEntry("Finished pulling MARA.")
    nCountMARC = PopulateMARCbyMATNR(R3, Sheets("PlantUpdateRFC").Range("B:B"))
    a = CreateLogEntry("Finished pulling MARC.")
    Call SortMARC
    a = CreateLogEntry("Finished sorting MARC.")
    
    Set wsHEADDATA = CreateTab("HEADDATA")
    nCurrentColumn = 0
    For nCurrent = 2 To 900
        If Sheets("tblDD03L").Range("A" & nCurrent) = "BAPIMATHEAD" Then
            nCurrentColumn = nCurrentColumn + 1
            wsHEADDATA.Range(FindExcelCell(nCurrentColumn, 1)).Value = Sheets("tblDD03L").Range("B" & nCurrent).Value
            wsHEADDATA.Range(FindExcelCell(nCurrentColumn, 1)).Font.Bold = True
            wsHEADDATA.Range(FindExcelCell(nCurrentColumn, 1)).Interior.Color = RGB(222, 222, 222)
        End If
    Next
    Set wsPLANTDATAX = CreateTab("PLANTDATAX")
    Set wsPLANTDATA = CreateTab("PLANTDATA")
    nCurrentColumn = 0
    For nCurrent = 2 To 900
        If Sheets("tblDD03L").Range("A" & nCurrent) = "BAPI_MARC" Then
            nCurrentColumn = nCurrentColumn + 1
            wsPLANTDATA.Range(FindExcelCell(nCurrentColumn, 1)).Value = Sheets("tblDD03L").Range("B" & nCurrent).Value
            wsPLANTDATA.Range(FindExcelCell(nCurrentColumn, 1)).Font.Bold = True
            wsPLANTDATA.Range(FindExcelCell(nCurrentColumn, 1)).Interior.Color = RGB(222, 222, 222)
            wsPLANTDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Value = Sheets("tblDD03L").Range("B" & nCurrent).Value
            wsPLANTDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Font.Bold = True
            wsPLANTDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Interior.Color = RGB(222, 222, 222)
        End If
    Next
    Set wsVALUATIONDATAX = CreateTab("VALUATIONDATAX")
    Set wsVALUATIONDATA = CreateTab("VALUATIONDATA")
    nCurrentColumn = 0
    For nCurrent = 2 To 900
        If Sheets("tblDD03L").Range("A" & nCurrent) = "BAPI_MBEW" Then
            nCurrentColumn = nCurrentColumn + 1
            wsVALUATIONDATA.Range(FindExcelCell(nCurrentColumn, 1)).Value = Sheets("tblDD03L").Range("B" & nCurrent).Value
            wsVALUATIONDATA.Range(FindExcelCell(nCurrentColumn, 1)).Font.Bold = True
            wsVALUATIONDATA.Range(FindExcelCell(nCurrentColumn, 1)).Interior.Color = RGB(222, 222, 222)
            wsVALUATIONDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Value = Sheets("tblDD03L").Range("B" & nCurrent).Value
            wsVALUATIONDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Font.Bold = True
            wsVALUATIONDATAX.Range(FindExcelCell(nCurrentColumn, 1)).Interior.Color = RGB(222, 222, 222)
        End If
    Next
        
    For nCurrentColumn = 2 To 20
        Range(Chr(64 + nCurrentColumn) & "1").Value = Trim(UCase(Range(Chr(64 + nCurrentColumn) & "1").Value))
    Next
    
    a = ActivatePlantMagicTab
    
    For nCurrent = 2 To 1048576
        If Range("B" & nCurrent).Value <> "" Then
            Range("B" & nCurrent & ":C" & nCurrent).Interior.Color = xlNone
            isProblem = False
            strPSTAT = ""
            Range("A" & nCurrent).Show
            strMATNR = Range("B" & nCurrent).Value
            strWERKS = Range("C" & nCurrent).Value
            
            strRange = GetMARCRange(strMATNR)
            For nCurrentPlant = Val(Left(strRange, 9)) To Val(Right(strRange, 9))
                If GetMARC(nCurrentPlant, "MATNR") = strMATNR Then
                    If GetMARC(nCurrentPlant, "WERKS") = strWERKS Then
                        
                        For nCurrentColumn = 4 To 20
                            strCurrentField = Range(Chr(64 + nCurrentColumn) & "1").Value
                            If strCurrentField <> "" Then
                                strTabName = GetTabName(strCurrentField)
                                strFieldName = GetFieldName(strCurrentField)
                                If strFieldName <> "" Then
                                    strTempPSTAT = GetPSTAT(Right(strTabName, 4) & "-" & strCurrentField, GetMARC(nCurrentPlant, "PSTAT"))
                                    If strTempPSTAT <> "" Then
                                        Range(Chr(64 + nCurrentColumn) & nCurrent).Interior.Color = RGB(0, 222, 0)
                                        strPSTAT = strPSTAT & strTempPSTAT
                                        If strTabName = "BAPI_MARC" Then
                                            a = WriteCell("PLANTDATA", "PLANT", nCurrent, strWERKS)
                                            a = WriteCell("PLANTDATA", strFieldName, nCurrent, Trim(Range(Chr(64 + nCurrentColumn) & nCurrent).Value))
                                            a = WriteCell("PLANTDATAX", "PLANT", nCurrent, strWERKS)
                                            a = WriteCell("PLANTDATAX", strFieldName, nCurrent, "X")
                                        Else
                                            a = WriteCell("VALUATIONDATA", "VAL_AREA", nCurrent, strWERKS)
                                            a = WriteCell("VALUATIONDATA", strFieldName, nCurrent, Trim(Range(Chr(64 + nCurrentColumn) & nCurrent).Value))
                                            a = WriteCell("VALUATIONDATAX", "VAL_AREA", nCurrent, strWERKS)
                                            a = WriteCell("VALUATIONDATAX", strFieldName, nCurrent, "X")
                                        End If
                                    Else
                                        Range(Chr(64 + nCurrentColumn) & nCurrent).Interior.Color = RGB(222, 0, 0)
                                        Range("A" & nCurrent).Value = "No view in Plant extension for field."
                                        isProblem = True
                                    End If
                                Else
                                    Range(Chr(64 + nCurrentColumn) & nCurrent).Interior.Color = RGB(222, 0, 0)
                                    Range("A" & nCurrent).Value = "Field does not exist."
                                    isProblem = True
                                End If
                            End If
                        Next
                        
                    End If
                End If
            Next
            If strPSTAT <> "" And Not isProblem Then
                If WriteCell("HEADDATA", "MATERIAL", nCurrent, Range("B" & nCurrent)) Then
                    If InStr(strPSTAT, "A") Then
                        a = WriteCell("HEADDATA", "WORK_SCHED_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "B") Then
                        a = WriteCell("HEADDATA", "ACCOUNT_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "D") Then
                        a = WriteCell("HEADDATA", "MRP_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "E") Then
                        a = WriteCell("HEADDATA", "PURCHASE_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "G") Then
                        a = WriteCell("HEADDATA", "COST_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "P") Then
                        a = WriteCell("HEADDATA", "FORECAST_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "Q") Then
                        a = WriteCell("HEADDATA", "QUALITY_VIEW", nCurrent, "X")
                    End If
                    If InStr(strPSTAT, "V") Then
                        a = WriteCell("HEADDATA", "ACCOUNT_VIEW", nCurrent, "X")
                    End If
                    Range("B" & nCurrent & ":C" & nCurrent).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        End If
        If nCurSec <> Second(Now()) Then
            RetVal = DoEvents
            If Range("B" & nCurrent).Value = "" Then
                Exit For
            End If
        End If
    Next
    Range("A1").Show
    R3.Connection.logoff
    Set R3 = Nothing
    nCurrent = Hour(Now - dStart) * 3600 + Minute(Now - dStart) * 60 + Second(Now - dStart)
    RetVal = MsgBox("The Check/Prepare phase has completed in " & nCurrent & " seconds.", vbOKOnly, "Finished")
End Sub


Sub SortDD03L(nRows As Long)
    Dim strTabName As String, nCurrent As Long
    
    For nCurrent = 2 To nRows + 1
        If Left(Sheets("tblDD03L").Range("B" & nCurrent).Value, 1) = "." Then
            Sheets("tblDD03L").Range("A" & nCurrent).Value = "zz_Ignore this."
        End If
    Next
    
    strTabName = "tblDD03L"
    ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("A2:A" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("E2:E" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(strTabName).Sort
        .SetRange Range("A2:AZ" & (1 + nRows))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Function WriteCell(strTabName As String, strHeader As String, nCurrent As Long, strValue As String) As Boolean
    Dim nCurrentHeader As Long
    For nCurrentHeader = 1 To 200
        If Sheets(strTabName).Range(FindExcelCell(nCurrentHeader, 1)).Value = strHeader Then
            Sheets(strTabName).Range(FindExcelCell(nCurrentHeader, nCurrent)).NumberFormat = "@"
            Sheets(strTabName).Range(FindExcelCell(nCurrentHeader, nCurrent)).Value = strValue
            WriteCell = True
            Exit Function
        End If
    Next
End Function
Function ReadCell(strTabName As String, strHeader As String, nCurrent As Long) As String
    Dim nCurrentHeader As Long
    For nCurrentHeader = 1 To 200
        If Sheets(strTabName).Range(FindExcelCell(nCurrentHeader, 1)).Value = strHeader Then
            ReadCell = Sheets(strTabName).Range(FindExcelCell(nCurrentHeader, nCurrent)).Value
            Exit Function
        End If
    Next
    ReadCell = ""
End Function
Function GetTabName(strField As String) As String
    Dim nCurrent As Long, nTranslate As Long
    For nCurrent = 2 To 999
        If Sheets("tblDD03L").Range("B" & nCurrent).Value = strField Then
            For nTranslate = 2 To 999
                If Sheets("tblDD03L").Range("A" & nTranslate).Value = "BAPI_" & Sheets("tblDD03L").Range("A" & nCurrent).Value Then
                    If Sheets("tblDD03L").Range("H" & nTranslate).Value = Sheets("tblDD03L").Range("H" & nCurrent).Value Then
                        'Found the correct field!!!  Return this.
                        GetTabName = Sheets("tblDD03L").Range("A" & nTranslate).Value
                        Exit Function
                    End If
                End If
            Next
        End If
    Next
End Function
Function GetFieldName(strField As String) As String
    Dim nCurrent As Long, nTranslate As Long
    For nCurrent = 2 To 999
        If Sheets("tblDD03L").Range("B" & nCurrent).Value = strField Then
            For nTranslate = 2 To 999
                If Sheets("tblDD03L").Range("A" & nTranslate).Value = "BAPI_" & Sheets("tblDD03L").Range("A" & nCurrent).Value Then
                    If Sheets("tblDD03L").Range("H" & nTranslate).Value = Sheets("tblDD03L").Range("H" & nCurrent).Value Then
                        'Found the correct field!!!  Return this.
                        GetFieldName = Sheets("tblDD03L").Range("B" & nTranslate).Value
                        Exit Function
                    End If
                End If
            Next
        End If
    Next
End Function
Function GetPSTAT(strField As String, strPSTAT As String) As String
    Dim nCurrent As Long, nCurrent2 As Long, nCurrent3 As Long
    For nCurrent = 2 To 9999
        If Sheets("tblT130F").Range("B" & nCurrent).Value = strField Then
            For nCurrent2 = 1 To Len(Sheets("tblT130F").Range("E" & nCurrent).Value)
                If InStr(strPSTAT, Mid(Sheets("tblT130F").Range("E" & nCurrent).Value, nCurrent2, 1)) Then
                    GetPSTAT = Mid(Sheets("tblT130F").Range("E" & nCurrent).Value, nCurrent2, 1)
                    Exit Function
                End If
            Next
        End If
    Next
End Function

Function ActivatePlantMagicTab() As Boolean
    'Sort the tabs to keep them neat.
    Dim nCurrent As Long, nCurrent2 As Long
    Dim wsA As Worksheet, wsB As Worksheet
    For nCurrent = 1 To Sheets.Count - 1
        For nCurrent2 = nCurrent + 1 To Sheets.Count
            If Sheets(nCurrent).Name = "PlantUpdateRFC" Then
                'Do nothing...
            ElseIf Sheets(nCurrent2).Name = "PlantUpdateRFC" Then
                'Sheets(nCurrent2).Move (Sheets(ncurrent1))
                Sheets(nCurrent2).Move before:=Sheets(nCurrent)
            Else
                If Len(Sheets(nCurrent2).Name) < Len(Sheets(nCurrent).Name) Then
                    Sheets(nCurrent2).Move before:=Sheets(nCurrent)
                End If
            End If
        Next
    Next
    Sheets("PlantUpdateRFC").Activate
    RetVal = DoEvents
End Function

Naturally, a connection to SAP for the purpose of performing the RFCs is required. That connection is created using the GetR3 function.

Function GetR3(ByRef R3 As Object) As Boolean
    Dim wsTemp As Worksheet
    Set wsTemp = CreateTab("Attention")
    wsTemp.Range("A1").Value = "Please sign into SAP."
    wsTemp.Range("A1").Font.Size = 33
    
    Set R3 = CreateObject("SAP.Functions")
    '*************************************
    '  Put in your own credentials here.
    '*************************************
    R3.Connection.System = "P01"
    R3.Connection.SystemNumber = "00"
    R3.Connection.client = "100"
    R3.Connection.User = ""  ' Put your User ID here.
    R3.Connection.Password = "" 'Put your password here (optional).
    R3.Connection.Language = "EN"
    R3.Connection.ApplicationServer = "your.server.hostname.here"  'or IP address.
       
    If R3.Connection.logon(0, True) <> True Then
       If R3.Connection.logon(0, False) <> True Then
            GetR3 = False
            Exit Function
       End If
    End If
    GetR3 = True
    a = NukeTab("Attention")
End Function

A handful of functions for adding and removing tabs (spreadsheets) to the Excel workbook are required for this code. They are included here along with a function that converts X & Y coordinates to Excel cell addresses.

Function CreateTab(strTabName) As Worksheet
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Application.DisplayAlerts = False
            objCurrentSheet.Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
    Set CreateTab = Sheets.Add
    CreateTab.Name = strTabName
End Function

Function GetTab(strTabName) As Worksheet
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Set GetTab = objCurrentSheet
            Exit Function
        End If
    Next
    Set GetTab = Sheets.Add
    GetTab.Name = strTabName
End Function

Function NukeTab(strTabName) As Boolean
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Application.DisplayAlerts = False
            objCurrentSheet.Delete
            Application.DisplayAlerts = True
            NukeTab = True
            Exit Function
        End If
    Next
    NukeTab = False
End Function


Function FindExcelCell(nX As Long, nY As Long) As String
    Dim nPower1 As Long, nPower2 As Long
    nPower2 = 0
    If nX > 26 Then
        nPower2 = Int((nX - 1) / 26)
    End If
    nPower1 = nX - (26 * nPower2)
    If nPower2 > 0 Then
        FindExcelCell = Chr(64 + nPower2) & Chr(64 + nPower1) & nY
    Else
        FindExcelCell = Chr(64 + nPower1) & nY
    End If
End Function

A small host of code snippets are called to tease out the MARA and MARC data and store them in a meaningful way. The sorting is included to increase the efficiency reading back the data (peeking) the data that has been stored (poked) into Excel using some simple addressing tricks.

Const nSetWidth As Long = 30

Function PopulateMARA(ByRef R3 As Object, objRange As Range) As Long
    Dim nCountMARA As Long, objCell As Object, strMaterial As String, strMaterialFilter As String, nMaterials As Long, nCurrentRow As Long
    Dim nCurSec As Integer, strSkipMaterials As String, wsMARA As Worksheet
    
    Set wsMARA = GetTab("MARA")
    
    'First, get the number of existing MARC rows...
    For nCurrentRow = 2 To 1048567
        If Sheets("MARA").Range("A" & Trim(nCurrentRow)).Value <> "" Then
            nCountMARA = nCurrentRow - 1
            strSkipMaterials = strSkipMaterials & Sheets("MARA").Range("A" & Trim(nCurrentRow)).Value
        Else
            Exit For
        End If
    Next

    For Each objCell In objRange.Cells
        If objCell.Value <> "" Then
            strMaterial = objCell.Value
            If InStr(strMaterialFilter, strMaterial) < 1 And InStr(strSkipMaterials, objCell.Value) < 1 Then
                If Sheets("MARA").Range("A:A").Find(strMaterial, LookIn:=xlValues) Is Nothing Then
                    If strMaterialFilter = "" Then
                        strMaterialFilter = "MATNR EQ '" & strMaterial & "'"
                    Else
                        strMaterialFilter = strMaterialFilter & " OR MATNR EQ " & "'" & strMaterial & "'"
                    End If
                Else
                    strSkipMaterials = strSkipMaterials & objCell.Value
                End If
            End If
            If Len(strMaterialFilter) > 9000 Then
                nMaterials = SAP_RFC_READ_TABLE(R3, "MARA", "tempMARA", "MATNR,MTART,MATKL,PSTAT,MEINS,NTGEW,BRGEW,GEWEI,PRDHA", strMaterialFilter)
                If nMaterials > 0 Then
                    Sheets("MARA").Range("A" & Trim(2 + nCountMARA) & ":H" & Trim(1 + nCountMARA + nMaterials)).NumberFormat = "@"
                    Sheets("MARA").Range("A" & Trim(2 + nCountMARA) & ":H" & Trim(1 + nCountMARA + nMaterials)).Value = Sheets("tempMARA").Range("A2:H" & Trim(1 + nMaterials)).Value
                    nCountMARA = nCountMARA + nMaterials
                End If
                strMaterialFilter = ""
            End If
        End If
        If nCurSec <> Second(Now) Then
            nCurSec = Second(Now)
            If nCurSec / 2 = Int(nCurSec / 2) Then
                Sheets("MARA").Tab.Color = RGB(222, 222, 22)
            Else
                Sheets("MARA").Tab.Color = RGB(111, 111, 11)
            End If
            DoEvents
        End If
    Next
    If strMaterialFilter <> "" Then
        nMaterials = SAP_RFC_READ_TABLE(R3, "MARA", "tempMARA", "MATNR,MTART,MATKL,PSTAT,MEINS,NTGEW,BRGEW,GEWEI,PRDHA", strMaterialFilter)
        If nMaterials > 0 Then
            Sheets("MARA").Range("A" & Trim(2 + nCountMARA) & ":H" & Trim(1 + nCountMARA + nMaterials)).NumberFormat = "@"
            Sheets("MARA").Range("A" & Trim(2 + nCountMARA) & ":H" & Trim(1 + nCountMARA + nMaterials)).Value = Sheets("tempMARA").Range("A2:H" & Trim(1 + nMaterials)).Value
            nCountMARA = nCountMARA + nMaterials
        End If
        strMaterialFilter = ""
    End If
    If nMaterials > 0 Then
        Sheets("MARA").Range("A1:H1").Value = Sheets("tempMARA").Range("A1:H1").Value
        Sheets("MARA").Range("A1:H1").Font.Bold = True
        Sheets("MARA").Range("A1:H1").Interior.Color = RGB(222, 222, 222)
    End If
    nCurrent = NukeTab("tempMARA")
    PopulateMARA = nCountMARA
    Sheets("MARA").Tab.Color = RGB(222, 222, 22)
End Function


Function GetMARA(strMATNR As String, strField As String) As String
    Static strLastMATNR As String, nLastCurrent As Long
    Dim nCurrent As Long, nCurrentField As Long, nStart As Long
    
    If Sheets("MARA").Range("A1").Interior.Color <> RGB(222, 222, 0) Then
        Call SortMARA
        Sheets("MARA").Range("A1").Interior.Color = RGB(222, 222, 0)
    End If
    If strMATNR = strLastMATNR And nLastCurrent <> 0 Then
        nStart = nLastCurrent
    Else
        nStart = 2
        strLastMATNR = strMATNR
        For nCurrent = 2 To 1040000 Step 1000
            If Sheets("MARA").Range("A" & nCurrent).Value > strMATNR Or Sheets("MARA").Range("A" & nCurrent).Value = "" Then
                Exit For
            End If
            If Sheets("MARA").Range("A" & nCurrent).Value < strMATNR Then
                nStart = nCurrent
            End If
        Next
        For nCurrent = nStart To 1040000 Step 100
            If Sheets("MARA").Range("A" & nCurrent).Value > strMATNR Or Sheets("MARA").Range("A" & nCurrent).Value = "" Then
                Exit For
            End If
            If Sheets("MARA").Range("A" & nCurrent).Value < strMATNR Then
                nStart = nCurrent
            End If
        Next
        For nCurrent = nStart To 1040000 Step 10
            If Sheets("MARA").Range("A" & nCurrent).Value > strMATNR Or Sheets("MARA").Range("A" & nCurrent).Value = "" Then
                Exit For
            End If
            If Sheets("MARA").Range("A" & nCurrent).Value < strMATNR Then
                nStart = nCurrent
            End If
        Next
    End If

    For nCurrent = nStart To 1048576
        If Sheets("MARA").Range("A" & nCurrent).Value = strMATNR Then
            For nCurrentField = 1 To 10
                If Sheets("MARA").Range(FindExcelCell(nCurrentField, 1)).Value = strField Then
                    GetMARA = Sheets("MARA").Range(FindExcelCell(nCurrentField, nCurrent)).Value
                    nLastCurrent = nCurrent
                    Exit Function
                End If
            Next
        End If
    Next
End Function


Sub SortMARA()
    Dim arr As Object
    Dim cell As Range, strTemp As Variant, nCurrent As Long, nCurrent2 As Long
    Dim nCountMARA As Long
    
    
    Set arr = CreateObject("System.Collections.ArrayList")
    For nCurrent = 1 To 1048575
        If Sheets("MARA").Range("A" & nCurrent).Value <> "" Then
            strTemp = Sheets("MARA").Range("A" & (1 + nCurrent)).Value & Right("000000000" & nCurrent, 9)
            arr.Add strTemp
            If nCurSec <> Second(Now) Then
                nCurSec = Second(Now)
                RetVal = DoEvents
            End If
        Else
            nCountMARA = nCurrent - 1
            Exit For
        End If
    Next
    arr.Sort
    
    Dim wsTemp As Worksheet
    Set wsTemp = CreateTab("tempMARA")
    Sheets("tempMARA").Range("A2:H" & nCurrent).NumberFormat = "@"
    Sheets("tempMARA").Range("A2:H" & nCurrent).Value = Sheets("MARA").Range("A2:H" & nCurrent).Value
    
    nCurrent = 0
    For Each strTemp In arr
        nCurrent = nCurrent + 1
        nCurrent2 = Val(Mid(strTemp, 19, 9))
        If nCurrent <> nCurrent2 Then
            Sheets("MARA").Range("A" & (nCurrent + 1) & ":H" & (nCurrent + 1)).Value = Sheets("tempMARA").Range("A" & (nCurrent2 + 1) & ":H" & (nCurrent2 + 1)).Value
            Sheets("tempMARA").Range("A" & (nCurrent2 + 1) & ":H" & (nCurrent2 + 1)).Clear
            If nCurSec <> Second(Now) Then
                nCurSec = Second(Now)
                If nCurSec / 2 = Int(nCurSec / 2) Then
                    Sheets("MARA").Tab.Color = RGB(222, 222, 22)
                Else
                    Sheets("MARA").Tab.Color = RGB(111, 111, 11)
                End If
                RetVal = DoEvents
            End If
        End If
    Next
    nCurrent = NukeTab("tempMARA")
    Sheets("MARA").Tab.Color = RGB(222, 222, 22)
End Sub


Function PopulateMARCbyMATNR(ByRef R3 As Object, objRange As Range) As Long
    Dim nCountMARA As Long, objCell As Object, strMaterial As String, strMaterialFilter As String, nMaterials As Long, nCurrentRow As Long
    Dim nCurSec As Integer, strSkipMaterials As String, strSkipPlants As String, nCurrent As Long
    Const strGetFields As String = "MATNR,WERKS,PSTAT,AUSME,DISMM,DISPO,DISLS,BESKZ,SOBSL,LOSGR,SOBSK,LGPRO,DISGR,LGFSB"
    Dim nLGORTs As Long, nCurrentLGORT As Long, strLGORTs As String, strOptions As String
    
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    '*                                                             *
    '*  This function only pulls a list of Plants associated with  *
    '*  the target Material Masters and then uses that data to     *
    '*  call the PopulateMARC function.                            *
    '*                                                             *
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    
            
    For Each objCell In objRange.Cells
        If objCell.Value <> "" Then
            strMaterial = objCell.Value
            If InStr(strMaterialFilter, strMaterial) < 1 And InStr(strSkipMaterials, objCell.Value) < 1 Then
                If strMaterialFilter = "" Then
                    strMaterialFilter = "MATNR EQ '" & strMaterial & "'"
                Else
                    strMaterialFilter = strMaterialFilter & " OR MATNR EQ " & "'" & strMaterial & "'"
                End If
                strSkipMaterials = strSkipMaterials & "," & objCell.Value
            End If
            If Len(strMaterialFilter) > 4000 Then
                a = CreateLogEntry("Pulling MARC entries for " & strMaterialFilter)
                nMaterials = SAP_RFC_READ_TABLE(R3, "MARC", "tempMARC", strGetFields, strMaterialFilter)
                If nMaterials > 0 Then
                    'nLGORTs = SAP_RFC_READ_TABLE(R3, "MARD", "tempMARD", "MATNR,WERKS,LGORT", strMaterialFilter)
                    'a = SortByFirstTwoColumns("tempMARC", nMaterials)
                    'a = SortByFirstTwoColumns("tempMARD", nLGORTs)
                    For nCurrentRow = 2 To nMaterials + 1
                        'strLGORTs = GetLGORTs(Sheets("tempMARC").Range("A" & nCurrentRow).Value, Sheets("tempMARC").Range("B" & nCurrentRow).Value)
                        'Sheets("tempMARC").Range("O" & nCurrentRow).Value = strLGORTs
                        nCountMARC = SetMARC(Sheets("tempMARC").Range("A" & nCurrentRow & ":O" & nCurrentRow))
                        If nCurSec <> Second(Now) Then
                            nCurSec = FlashTab("MARC")
                        End If
                    Next
                End If
                strMaterialFilter = ""
            End If
        End If
        If nCurSec <> Second(Now) Then
            nCurSec = FlashTab("MARC")
        End If
    Next
    If strMaterialFilter <> "" Then
        a = CreateLogEntry("Pulling MARC entries for " & strMaterialFilter)
        nMaterials = SAP_RFC_READ_TABLE(R3, "MARC", "tempMARC", strGetFields, strMaterialFilter)
        If nMaterials > 0 Then
            'nLGORTs = SAP_RFC_READ_TABLE(R3, "MARD", "tempMARD", "MATNR,WERKS,LGORT", strMaterialFilter)
            'a = SortByFirstTwoColumns("tempMARC", nMaterials)
            'a = SortByFirstTwoColumns("tempMARD", nLGORTs)
            For nCurrentRow = 2 To nMaterials + 1
                'strLGORTs = GetLGORTs(Sheets("tempMARC").Range("A" & nCurrentRow).Value, Sheets("tempMARC").Range("B" & nCurrentRow).Value)
                'Sheets("tempMARC").Range("O" & nCurrentRow).Value = strLGORTs
                nCountMARC = SetMARC(Sheets("tempMARC").Range("A" & nCurrentRow & ":O" & nCurrentRow))
                If nCurSec <> Second(Now) Then
                    nCurSec = FlashTab("MARC")
                End If
            Next
        End If
        strMaterialFilter = ""
    End If
    If nMaterials > 0 Then
        Sheets("MARC").Range("A1:O1").Value = Sheets("tempMARC").Range("A1:O1").Value
        'Sheets("MARC").Range("O1").Value = "LGORTS"
        Sheets("MARC").Range("A1:O1").Font.Bold = True
        Sheets("MARC").Range("A1:O1").Interior.Color = RGB(222, 222, 222)
    End If
    nCurrent = NukeTab("tempMARC")
    'nCurrent = NukeTab("tempMARD")
    Sheets("MARA").Tab.Color = RGB(222, 222, 22)
    PopulateMARCbyMATNR = nCountMARA
End Function


Function FlashTab(strTabName As String) As Long
    Dim nCurSec As Long, nCurrentRGB As Long
    nCurSec = Second(Now)
    If nCurSec / 2 = Int(nCurSec / 2) Then
        nCurrentRGB = nCurSec * 3
    Else
        nCurrentRGB = 255 - (nCurSec * 3)
    End If
    Sheets(strTabName).Tab.Color = RGB(nCurrentRGB, 255 - nCurrentRGB, nCurrentRGB) '(256 ^ 3) - Sheets(strTabName).Tab.Color
    RetVal = DoEvents
    FlashTab = Second(Now)
End Function




Function SetMARC(objRange As Range) As Long
    Static nCountMARC As Long, wsMARC As Worksheet, nCurrentSet As Long, nCurrent As Long, nCurrentLine As Long
    Dim nRangeLength As Long, nStart As Long
    'Const nSetWidth As Long = 30
    Set wsMARC = Sheets("MARC")
    If wsMARC.Range("A2").Value = "" Then
        nCountMARC = 0 'Refreshed!
    End If
    If nCountMARC = 0 Or objRange.Cells.Count = 1 Then
        For nCurrentSet = 21 To 0 Step -1
            If wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 2)).Value <> "" Then
                nCountMARC = 1000000 * nCurrentSet
                If nCurrentSet = 0 Then
                    nStart = 2
                Else
                    nStart = 1
                End If
                For nCurrent = nStart To 1048000
                    If wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), nCurrent)).Value <> "" Then
                        nCountMARC = nCountMARC + 1
                    Else
                        Exit For
                    End If
                    If nCurSec <> Second(Now) Then
                        nCurSec = Second(Now)
                        RetVal = DoEvents
                    End If
                Next
                Exit For
            End If
        Next
    End If
    If objRange.Cells.Count > 1 Then
        nCountMARC = nCountMARC + 1
        nCurrentSet = Int(nCountMARC / 1000000)
        nCurrentLine = nCountMARC - Int(nCurrentSet * 1000000)
        'If nCurrentLine > 1000000 Then
        '    nCurrentSet = nCurrentSet + 1
        '    nCurrentLine = nCountMARC - Int(nCurrentSet * 1000000)
        'End If
        nRangeLength = objRange.Cells.Count
        wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 1 + nCurrentLine) & ":" & FindExcelCell(nRangeLength + (nCurrentSet * nSetWidth), 1 + nCurrentLine)).NumberFormat = "@"
        wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 1 + nCurrentLine) & ":" & FindExcelCell(nRangeLength + (nCurrentSet * nSetWidth), 1 + nCurrentLine)).Value = objRange.Value
    End If
    SetMARC = nCountMARC
End Function

Function IsInMARC(strPlant As String) As Boolean
    Dim wsMARC As Worksheet, nCurrentSet As Long, nCurrent As Long, nCurrentLine As Long
    Dim nRangeLength As Long
    Static strIsInMARC As String
    'Const nSetWidth As Long = 30
    
    If InStr(strIsInMARC, strPlant) > 1 Then
        IsInMARC = True
        Exit Function
    End If
    
    Dim nPower1 As Long, nPower2 As Long, strHeaderColumn As String
    Set wsMARC = Sheets("MARC")
    
    For nCurrentSet = 21 To 0 Step -1
        nCurrent = 2 + (nSetWidth * nCurrentSet) 'MARC Column
        nPower2 = 0
        If nCurrent > 26 Then
            nPower2 = Int((nCurrent - 1) / 26)
        End If
        nPower1 = nCurrent - (26 * nPower2)
        If nPower2 > 0 Then
            strHeaderColumn = Chr(64 + nPower2) & Chr(64 + nPower1)
        Else
            strHeaderColumn = Chr(64 + nPower1)
        End If
        If wsMARC.Range(strHeaderColumn & "2").Value <> "" Then
            'There is something in this set...
            If Not Sheets("MARC").Range(strHeaderColumn & ":" & strHeaderColumn).Find(strPlant, LookIn:=xlValues) Is Nothing Then
                IsInMARC = True
                strIsInMARC = strIsInMARC & "," & strPlant
                Exit Function
            End If
        End If
    Next
    IsInMARC = False
End Function

Function GetMARC(nCurrent As Long, strField As String) As String
    Static nCountMARC As Long, wsMARC As Worksheet, nCurrentSet As Long, nCurrentLine As Long
    'Static nLastCurrent As Long, strLastField As String, strLastValue As String
    Dim nCurrentColumn As Long
    Static strColumns(70) As String
    'Const nSetWidth As Long = 30
    
    'If nCurrent = 0 Then
    '    GetMARC = ""
    '    Exit Function
    'End If
    
    If strColumns(1) = "" Then
        For nCurrentColumn = 1 To 70
            strColumns(nCurrentColumn) = Sheets("MARC").Range(FindExcelCell(nCurrentColumn, 1)).Value
        Next
    End If
    
    nCurrentSet = Int(nCurrent / 1000000)
    nCurrentLine = nCurrent - (1000000 * nCurrentSet)
    
    For nCurrentColumn = 1 To 70
        If strColumns(nCurrentColumn) = strField Then
            Exit For
        End If
    Next
    
    GetMARC = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + nCurrentColumn, nCurrentLine + 1)).Value
    
End Function

Function GetMARCRange(strMATNR As String) As String
    Static nCount As Long, strRanges(999999, 1) As String, nCountMARC As Long
    Static strLastMATNR As String, nLastLast As Long, nStart As Long
    Dim nCurrent As Long, nFirst As Long, nLast As Long, nCurrentMATNR As String
    
    nStart = 1
    
    If Sheets("MARC").Range("A1048570").Value <> "" Then
        'This was just sorted.  Start from scratch...
        Sheets("MARC").Range("A1048570").Value = ""
        nCount = 0
        nCountMARC = 0
        nLastLast = 1
    End If
    
    
    For nCurrent = 1 To nCount
        If strRanges(nCurrent, 1) = strMATNR Then
            GetMARCRange = strRanges(nCurrent, 0)
            Exit Function
        End If
    Next
    
    If nCountMARC = 0 Then
        nCountMARC = SetMARC(Range("ZZ9"))
    End If
    
    'Seriously speed this process up . . .
    If strLastMATNR < strMATNR And nLastLast <> 0 Then
        nStart = nLastLast
    Else
        For nCurrent = 1000 To nCountMARC - 2000 Step 1000
            If GetMARC(nCurrent, "MATNR") < strMATNR Then
                nStart = nCurrent
            Else
                Exit For
            End If
        Next
    End If
    
    nFirst = 0
    nLast = 0
    For nCurrent = nStart To nCountMARC
        If GetMARC(nCurrent, "MATNR") = strMATNR Then
            If nFirst = 0 Then
                nFirst = nCurrent
            End If
            nLast = nCurrent
        Else
            If nLast > 0 Then
                Exit For
            End If
            If GetMARC(nCurrent, "MATNR") > strMATNR Then
                'The Material Master isn't in this list.
                Exit For
            End If
        End If
    Next
    nCount = nCount + 1
    strRanges(nCount, 1) = strMATNR
    strRanges(nCount, 0) = Right("000000000" & nFirst, 9) & Right("000000000" & nLast, 9)
    GetMARCRange = strRanges(nCount, 0)
    strLastMATNR = strMATNR
    nLastLast = nLast
End Function


Function CreateLogEntry(strLogEntry As String) As Boolean
    Sheets("tblT130F").Range("Y1:Z99").Copy Destination:=Sheets("tblT130F").Range("Y2:Z100")
    Sheets("tblT130F").Range("Y1").Value = Now
    Sheets("tblT130F").Range("Z1").Value = strLogEntry
End Function

Sub SortMARC()
    Dim nCurrentColumn As Long, nCurrent As Long, nCurrent2 As Long, nCurSec As Long
    Dim nCountMARC As Long, strTemp As Variant
    Dim nCurrentSet As Long, nCurrentLine As Long
    Dim nCurrentSet2 As Long, nCurrentLine2 As Long
    
    Static strColumns(70) As String
    'Const nSetWidth As Long = 30
        
    'Get the number of Plant extensions in the MARC tab...
    nCountMARC = SetMARC(Range("ZZ9"))
    
    'Set these to be stored as text.
    'Sheets("MARC").Range(FindExcelCell(1, 1048570) & ":" & FindExcelCell(70, 1048570)).NumberFormat = "@"
    Sheets("MARC").Range("A1048570").Value = "Sorted"
        
    Dim arr As Object
    Dim cell As Range
    
    Set arr = CreateObject("System.Collections.ArrayList")
    For nCurrent = 1 To nCountMARC
        nCurrentSet = Int(nCurrent / 1000000)
        nCurrentLine = nCurrent - (1000000 * nCurrentSet)
        strTemp = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1)).Value & Right("000000000" & nCurrent, 9)
        arr.Add strTemp
        If nCurSec <> Second(Now) Then
            nCurSec = Second(Now)
            If nCurSec / 2 = Int(nCurSec / 2) Then
                Sheets("MARC").Tab.Color = RGB(222, 22, 222)
            Else
                Sheets("MARC").Tab.Color = RGB(111, 11, 111)
            End If
            RetVal = DoEvents
        End If
    Next
    arr.Sort
    
    Dim wsTemp As Worksheet
    Set wsTemp = CreateTab("tempMARC")
    
    nCurrent = 0
    For Each strTemp In arr
        nCurrent = nCurrent + 1
        nCurrent2 = Val(Mid(strTemp, 19, 9))
        If nCurrent <> nCurrent2 Then
            nCurrentSet = Int(nCurrent / 1000000)
            nCurrentLine = nCurrent - (1000000 * nCurrentSet)
            nCurrentSet2 = Int(nCurrent2 / 1000000)
            nCurrentLine2 = nCurrent2 - (1000000 * nCurrentSet2)
            'Sheets("MARC").Range(FindExcelCell(1, 1048570) & ":" & FindExcelCell(70, 1048570)).Value = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value
            Sheets("tempMARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).NumberFormat = "@"
            Sheets("tempMARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value
            If nCurrent2 < nCurrent Then
                Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("tempMARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value
                Sheets("tempMARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Clear
            Else
                Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("MARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value
            End If
            'Sheets("MARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value = Sheets("MARC").Range(FindExcelCell(1, 1048570) & ":" & FindExcelCell(70, 1048570)).Value
        End If
        If nCurSec <> Second(Now) Then
            nCurSec = Second(Now)
            If nCurSec / 2 = Int(nCurSec / 2) Then
                Sheets("MARC").Tab.Color = RGB(222, 22, 222)
            Else
                Sheets("MARC").Tab.Color = RGB(111, 11, 111)
            End If
            Sheets("tempMARC").Range("A1").Value = "Sorting...  " & Int(100 * (nCurrent / nCountMARC)) & "% completed."
            RetVal = DoEvents
        End If
    Next
    
    Set arr = Nothing
    a = NukeTab("tempMARC")
    
End Sub

Step 2: Loading the prepared data

For this example, these structures are populated with data that will be used to affect changes to existing Material Master Plant extensions. The BAPI will use the data in these structures to update fields in the MARC and MBEW tables associated with the Material Masters.

• HEADDATA
• PLANTDATA
• PLANTDATAX
• VALUATIONDATA
• VALUATIONDATAX

Only after analyzing the code and combing through documentation on BAPI_MATERIAL_SAVEDATA do the structures ending with "X" seem intuitive; these tell the BAPI which fields are to be updated allowing for individual fields to be updated without having to populate the entire structure with existing data. For example, in each case that a value is to be changed to a field's value from the PLANTDATA structure, the same field in PLANTDATAX must be ticked with an "X"; those fields that are not ticked will be ignored.

Because all of the heavy lifting is performed by the code above, the code below that actually loads the prepared data is very simple. It populates the structures listed above with the data that has already been validated and prepared, passes them to the BAPI as parameters, performs the RFC and then captures the BAPIRET2 return value which is used to report the status of the load for that record.

Sub LoadData()
    Dim R3 As Object, nCurrent As Long, nCurrentColumn As Long, strTabName As String
    Dim strHeader As String, dStart As Date, nCurSec As Long
    
    dStart = Now 'Report how long this takes.

    a = ActivatePlantMagicTab

    If Not GetR3(R3) Then
        Exit Sub
    End If

    Dim HEADDATA As Object
    Dim PLANTDATA As Object
    Dim PLANTDATAX As Object
    Dim VALUATIONDATA As Object
    Dim VALUATIONDATAX As Object

    Set MyFunc = R3.Add("BAPI_MATERIAL_SAVEDATA")
    
    Set HEADDATA = MyFunc.exports("HEADDATA")
    Set PLANTDATA = MyFunc.exports("PLANTDATA")
    Set PLANTDATAX = MyFunc.exports("PLANTDATAX")
    Set VALUATIONDATA = MyFunc.exports("VALUATIONDATA")
    Set VALUATIONDATAX = MyFunc.exports("VALUATIONDATAX")

    For nCurrent = 2 To 1048576
        If Sheets("PlantUpdateRFC").Range("B" & nCurrent).Value <> "" Then
            If Sheets("PlantUpdateRFC").Range("A" & nCurrent).Value = "" Then 'Not done yet, no error
                If Sheets("HEADDATA").Range("A" & nCurrent).Value <> "" Then 'Data ready to load
                
                    For nCurrentColumn = 2 To 300
                        strHeader = Sheets("tblDD03L").Range("B" & nCurrentColumn).Value
                        If strHeader = "" Then
                            Exit For
                        End If
                        If Sheets("tblDD03L").Range("A" & nCurrentColumn).Value = "BAPIMATHEAD" Then
                            HEADDATA(strHeader) = ReadCell("HEADDATA", strHeader, nCurrent)
                        End If
                        If Sheets("tblDD03L").Range("A" & nCurrentColumn).Value = "BAPI_MARC" Then
                            PLANTDATA(strHeader) = ReadCell("PLANTDATA", strHeader, nCurrent)
                            PLANTDATAX(strHeader) = ReadCell("PLANTDATAX", strHeader, nCurrent)
                        End If
                        If Sheets("tblDD03L").Range("A" & nCurrentColumn).Value = "BAPI_MBEW" Then
                            VALUATIONDATA(strHeader) = ReadCell("VALUATIONDATA", strHeader, nCurrent)
                            VALUATIONDATAX(strHeader) = ReadCell("VALUATIONDATAX", strHeader, nCurrent)
                        End If
                    Next
                    
                    Set BAPIRET2 = MyFunc.Tables("RETURNMESSAGES")
                    BAPIRET2.Rows.RemoveAll
                    
                    Result = MyFunc.Call
                    
                    If Result = True Then
                        Set BAPIRET2 = MyFunc.Tables("RETURNMESSAGES")
                    Else
                        'MsgBox MyFunc.EXCEPTION
                        Sheets("PlantUpdateRFC").Range("A" & nCurrentRow).Value = MyFunc.exception
                    End If
                    
                    For Each objReturn In BAPIRET2.Rows
                        If objReturn("TYPE") = "S" Then
                            Sheets("PlantUpdateRFC").Range("A" & nCurrent).Value = objReturn("MESSAGE")
                            Sheets("PlantUpdateRFC").Range("B" & nCurrent & ":C" & nCurrent).Interior.Color = RGB(0, 222, 0)
                            Range("D" & nCurrent & ":V" & nCurrent).Interior.Color = xlNone
                            Sheets("HEADDATA").Range("A" & nCurrent).Value = "" 'Don't allow this to load again--force re-check.
                        End If
                        If objReturn("TYPE") = "E" Then
                            Sheets("PlantUpdateRFC").Range("A" & nCurrent).Value = objReturn("MESSAGE")
                            Sheets("PlantUpdateRFC").Range("B" & nCurrent & ":C" & nCurrent).Interior.Color = RGB(222, 0, 0)
                            Exit For
                        End If
                    Next
                    BAPIRET2.Rows.RemoveAll
                    
                End If
            End If
            If nCurSec <> Second(Now) Then
                RetVal = DoEvents
                If Second(Now) / 15 = Int(Second(Now) / 15) Then
                    Sheets("PlantUpdateRFC").Range("A" & (10 + nCurrent)).Show
                End If
            End If
        End If
    Next
    Range("A1").Show
    R3.Connection.logoff
    Set R3 = Nothing
    nCurrent = Hour(Now - dStart) * 3600 + Minute(Now - dStart) * 60 + Second(Now - dStart)
    RetVal = MsgBox("The Load phase has completed in " & nCurrent & " seconds.", vbOKOnly, "Finished")
End Sub

The SAP_RFC_READ_TABLE function, along with a more indepth discussion on poking and peeking data into Excel's addressing system, is available on this page. Additionally, it is included in the file linked below which has headers and buttons conveniently included; it looks like this.

The yellow headers can be populated with multiple feildnames from MARC and MBEW and the code populates the appropriate field in the structures passed in as parameters to the BAPI. The purpose of this functionality is to obviate the need to memorize fieldnames from the BAPI_MARC and BAPI_MBEW structures when most Material Master resources are already familiar with the fieldnames from MARC and MBEW.

Things to watch out for

If Excel throws a random error with no description or information other than "409" then it is very likely that the user account being used to connect to the SAP system to perform Remote Function Calls (RFCs) does not have permission to connect to the SAP server to perform RFCs. Reach out to the security team or the BASIS team to see if it is at all possible to get RFC acccess.

Sometimes Excel may throw a "404" error. It isn't clear, but this is likely a lost connection to the server and not a missing web page. Click OK to close the error message and then start again. In the Load step, the software will pick up where it left off.

Download the tool

Please understand that this tool is provided here for free and comes with no warranty, expressed or implied. Support tends to be slow, but can be obtained at this link.

_MaterialMasterPlantUpdateRFC.xlsm