Need help with a "Cells(r, 2) = MyPSOBJ.GetData(5, 6, 28)" Array and a "LocationNo = Cells(r, 1).Value" Array

Jeremy4110 · Aug 3, 2016

Hi,

I'm trying to speed up two scripts that I use to pull information from and load information to our system, both scripts work as is. However, they pull data from our mainframe one field at a time. I was wondering if there was a way to create an array that would pull data from every field identified below at one time, then put that information in excel in one step like the header row array? Also, I was wondering, is there was a way to mass update the "r" (r, 2) value with an array? I have tried several variations to set up the (row, column) with no success. Any help that someone can provide is greatly appreciated.

Code:

Sub Supplier_Location_Pull()
'

    'Row Headings
    Range("A1:AP1").Value = Array("LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", "ADD3 - Notes", "City", _
    "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", "MX-US $", "Website - Notes", "Email - Notes", _
    "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", "EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", _
    "HQ", "No-SupS", "SIM", "Last Update", "Review Date", "Review By", "No PO $", "Min PO $", "GPC")
    Range("A1:AP1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("A:A,D:D").NumberFormat = "000000"
    Range("B:B,J:J,V:V,AK:AL").NumberFormat = "@"
    
    Aviva_Activate
    
    RC = MyPSOBJ.sendString("{pf5}")
    
    '**** LOOP THROUGH LIST ****

    r = 2

    LocationNo = Cells(2, 1).Value
    
    While LocationNo <> ""
        
        RC = MyPSOBJ.WaitForString("FM18                       ", 1, 2)
        RC = MyPSOBJ.setcursorlocation(5, 21) & MyPSOBJ.sendString(LocationNo & "{enter}")
        
        Message = MyPSOBJ.GetData(32, 23, 2)
                If Message = "EM04-NO MATCHING DATA WAS FOUND." Then
                    LocationNo = ""
                    MFGID = "Invalid"
                Else
            RC = MyPSOBJ.WaitForString("FM19                 ", 1, 2)
            
            
            
            'IS THERE A WAY TO MAKE THIS AN ARRAY
            'START OF ARRAY
            Cells(r, 2) = MyPSOBJ.GetData(5, 6, 28)         'MFGID
            Cells(r, 3) = MyPSOBJ.GetData(25, 5, 28)        'Supplier_Name
            Cells(r, 4) = MyPSOBJ.GetData(6, 8, 22)         'Reassigned
            Cells(r, 5) = MyPSOBJ.GetData(25, 9, 19)        'Add1
            Cells(r, 6) = MyPSOBJ.GetData(25, 10, 19)       'Add2
            Cells(r, 7) = MyPSOBJ.GetData(25, 11, 19)       'Add3 - Notes
            Cells(r, 8) = MyPSOBJ.GetData(25, 12, 19)       'City
            Cells(r, 9) = MyPSOBJ.GetData(2, 12, 55)        'State
            Cells(r, 10) = MyPSOBJ.GetData(8, 12, 65)       'Zip
            Cells(r, 11) = MyPSOBJ.GetData(4, 12, 76)       'Zip4
            Cells(r, 12) = MyPSOBJ.GetData(25, 13, 19)      'Country
            Cells(r, 13) = MyPSOBJ.GetData(1, 9, 69)        'Language
            Cells(r, 14) = MyPSOBJ.GetData(20, 15, 8)       'Phone1
            Cells(r, 15) = MyPSOBJ.GetData(20, 15, 35)      'Phone2
            Cells(r, 16) = MyPSOBJ.GetData(20, 15, 60)      'Fax
            Cells(r, 17) = MyPSOBJ.GetData(1, 10, 69)       'Candian / US Currency
            Cells(r, 18) = MyPSOBJ.GetData(1, 13, 69)       'Mexican / US Currency
            Cells(r, 19) = MyPSOBJ.GetData(40, 16, 16)      'Webaddress
            Cells(r, 20) = MyPSOBJ.GetData(40, 17, 16)      'Email Address - Notes
            Cells(r, 21) = MyPSOBJ.GetData(25, 14, 19)      'Attention
            Cells(r, 22) = MyPSOBJ.GetData(6, 8, 72)        'A/P Number
            Cells(r, 23) = MyPSOBJ.GetData(1, 18, 23)       'Valid For Purchasing
            Cells(r, 24) = MyPSOBJ.GetData(1, 18, 49)       'Active / Inactive
            Cells(r, 25) = MyPSOBJ.GetData(1, 21, 23)       'Supplier Connect
            Cells(r, 26) = MyPSOBJ.GetData(1, 20, 23)       'Fax Capable
            Cells(r, 27) = MyPSOBJ.GetData(1, 20, 53)       'EDI Capable
            Cells(r, 28) = MyPSOBJ.GetData(3, 21, 53)       'Branch Transmit Method
            Cells(r, 29) = MyPSOBJ.GetData(3, 22, 53)       'DC Transmit Method
            Cells(r, 30) = MyPSOBJ.GetData(1, 21, 70)       'Branch FORCE Method
            Cells(r, 31) = MyPSOBJ.GetData(1, 22, 70)       'DC FORCE Method
            Cells(r, 32) = MyPSOBJ.GetData(5, 18, 75)       'MBEC
            Cells(r, 33) = MyPSOBJ.GetData(1, 19, 53)       'Minority Business
            Cells(r, 34) = MyPSOBJ.GetData(1, 19, 23)       'Headquaters
            Cells(r, 35) = MyPSOBJ.GetData(1, 11, 69)       'Non Supported Supplier
            Cells(r, 36) = MyPSOBJ.GetData(1, 22, 23)       'SIM Expediting
            Cells(r, 37) = MyPSOBJ.GetData(8, 7, 72)        'Last Update
            Cells(r, 38) = MyPSOBJ.GetData(8, 7, 18)        'Late Review Date
            Cells(r, 39) = MyPSOBJ.GetData(8, 7, 41)        'Reviewed By
            Cells(r, 40) = MyPSOBJ.GetData(1, 14, 69)       'No PO Dollar Minimum
            Cells(r, 41) = MyPSOBJ.GetData(8, 17, 69)       'PO Dollar Minimum Amount
            Cells(r, 42) = MyPSOBJ.GetData(1, 20, 74)       'GPC Shipping Program
            'END OF ARRAY
            
            
            
            RC = MyPSOBJ.sendString("{pf12}")
                     
            End If
        
        r = r + 1
        LocationNo = Cells(r, 1).Value
        
    Wend
    
    Columns("A:AZ").Select
    Selection.Replace What:="_", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    'Start Other Script
    Sup_Loc_AnyScript_Trim
    'End Other Script
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False
    
End Sub

Code:

Sub Supplier_Location_Change_Information()

    Activate_Aviva
        
    RC = MyPSOBJ.sendString("{pf5}")
    
    '**** This macro is designed to change mulitple location numbers with
    '**** the same data across the board.. Script should start on the FM18 screen
    '**** LOOP THROUGH LIST ****
    
    r = 2
    
    
                
            
            
    'IS THERE A WAY TO MAKE THIS AN ARRAY
    'START OF ARRAY
    LocationNo = Cells(r, 1).Value
    New_MFGID = Cells(r, 2).Value
    New_Supplier_Name = Cells(r, 3).Value
    New_Reassigned = Cells(r, 4).Value
    New_ADD1 = Cells(r, 5).Value
    New_ADD2 = Cells(r, 6).Value
    New_ADD3 = Cells(r, 7).Value
    New_City = Cells(r, 8).Value
    New_State = Cells(r, 9).Value
    New_Zip = Cells(r, 10).Value
    New_Zip4 = Cells(r, 11).Value
    New_Country = Cells(r, 12).Value
    New_Lan = Cells(r, 13).Value
    New_Phone1 = Cells(r, 14).Value
    New_Phone2 = Cells(r, 15).Value
    New_Fax = Cells(r, 16).Value
    New_CA_US$ = Cells(r, 17).Value
    New_MX_US$ = Cells(r, 18).Value
    New_Website1 = Cells(r, 19).Value
    New_Website2 = Cells(r, 20).Value
    New_Attention = Cells(r, 21).Value
    New_APNo = Cells(r, 22).Value
    New_VFP = Cells(r, 23).Value
    New_A_I = Cells(r, 24).Value
    New_Sup_Con = Cells(r, 25).Value
    New_FAX_Cap = Cells(r, 26).Value
    New_EDI_Cap = Cells(r, 27).Value
    New_BR_Emit = Cells(r, 28).Value
    New_DC_Emit = Cells(r, 29).Value
    New_BR_FM = Cells(r, 30).Value
    New_DC_FM = Cells(r, 31).Value
    New_MBEC = Cells(r, 32).Value
    New_MB = Cells(r, 33).Value
    New_HQ = Cells(r, 34).Value
    New_No_SupS = Cells(r, 35).Value
    New_SIMS = Cells(r, 36).Value
    New_Last_Update = Cells(r, 37).Value
    New_Review_Update = Cells(r, 38).Value
    New_Review_By = Cells(r, 39).Value
    New_No_PO$ = Cells(r, 40).Value
    New_Min_PO$ = Cells(r, 41).Value
    New_GPC = Cells(r, 42).Value
    'End Array
    
    
    
    
    While LocationNo <> ""
        
        RC = MyPSOBJ.WaitForString("FM18                       ", 1, 2)
        
        'new LocationNo
        RC = MyPSOBJ.setcursorlocation(5, 21) & MyPSOBJ.sendString(LocationNo & "{enter}") _
        & MyPSOBJ.WaitForString("FM19                 ", 1, 2)
        'new New_MFGID
        RC = MyPSOBJ.setcursorlocation(6, 28) & MyPSOBJ.sendString("{eraseeof}" & New_MFGID)
        'new Supplier_Name
        RC = MyPSOBJ.setcursorlocation(5, 28) & MyPSOBJ.sendString("{eraseeof}" & New_Supplier_Name)
        'new Reassigned
        RC = MyPSOBJ.setcursorlocation(8, 22) & MyPSOBJ.sendString("{eraseeof}" & New_Reassigned)
        'new ADD1
        RC = MyPSOBJ.setcursorlocation(9, 19) & MyPSOBJ.sendString("{eraseeof}" & New_ADD1)
        'new ADD2
        RC = MyPSOBJ.setcursorlocation(10, 19) & MyPSOBJ.sendString("{eraseeof}" & New_ADD2)
        'new ADD3
        RC = MyPSOBJ.setcursorlocation(11, 19) & MyPSOBJ.sendString("{eraseeof}" & New_ADD3)
        'new City
        RC = MyPSOBJ.setcursorlocation(12, 19) & MyPSOBJ.sendString("{eraseeof}" & New_City)
        'new State
        RC = MyPSOBJ.setcursorlocation(12, 55) & MyPSOBJ.sendString("{eraseeof}" & New_State)
        'new Zip
        RC = MyPSOBJ.setcursorlocation(12, 65) & MyPSOBJ.sendString("{eraseeof}" & New_Zip)
        'new Zip4
        RC = MyPSOBJ.setcursorlocation(12, 76) & MyPSOBJ.sendString("{eraseeof}" & New_Zip4)
        'new Country
        RC = MyPSOBJ.setcursorlocation(13, 19) & MyPSOBJ.sendString("{eraseeof}" & New_Country)
        'new Lan
        RC = MyPSOBJ.setcursorlocation(9, 69) & MyPSOBJ.sendString("{eraseeof}" & New_Lan)
        'new Phone1
        RC = MyPSOBJ.setcursorlocation(15, 8) & MyPSOBJ.sendString("{eraseeof}" & New_Phone1)
        'new Phone2
        RC = MyPSOBJ.setcursorlocation(15, 35) & MyPSOBJ.sendString("{eraseeof}" & New_Phone2)
        'new Fax
        RC = MyPSOBJ.setcursorlocation(15, 60) & MyPSOBJ.sendString("{eraseeof}" & New_Fax)
        'new CA-US$
        RC = MyPSOBJ.setcursorlocation(10, 69) & MyPSOBJ.sendString("{eraseeof}" & New_CA_US$)
        'new MX-US$
        RC = MyPSOBJ.setcursorlocation(13, 69) & MyPSOBJ.sendString("{eraseeof}" & New_MX_US$)
        'new Website1
        RC = MyPSOBJ.setcursorlocation(16, 16) & MyPSOBJ.sendString("{eraseeof}" & New_Website1)
        'new Website2
        RC = MyPSOBJ.setcursorlocation(17, 16) & MyPSOBJ.sendString("{eraseeof}" & New_Website2)
        'new Attention
        RC = MyPSOBJ.setcursorlocation(14, 19) & MyPSOBJ.sendString("{eraseeof}" & New_Attention)
        'new A/P No - This field is not to be updated
        'rc = MyPSOBJ.setcursorlocation(8, 72) & MyPSOBJ.sendString("{eraseeof}" & New_APNo)
        'new Valid_For_Purchasing
        RC = MyPSOBJ.setcursorlocation(18, 23) & MyPSOBJ.sendString("{eraseeof}" & New_VFP)
        'new Active
        RC = MyPSOBJ.setcursorlocation(18, 49) & MyPSOBJ.sendString("{eraseeof}" & New_A_I)
        'new Supplier_Connect
        RC = MyPSOBJ.setcursorlocation(21, 23) & MyPSOBJ.sendString("{eraseeof}" & New_Sup_Con)
        'new FAX Cap
        RC = MyPSOBJ.setcursorlocation(20, 23) & MyPSOBJ.sendString("{eraseeof}" & New_FAX_Cap)
        'new EDI Cap
        RC = MyPSOBJ.setcursorlocation(20, 53) & MyPSOBJ.sendString("{eraseeof}" & New_EDI_Cap)
        'new PO Emit Br
        RC = MyPSOBJ.setcursorlocation(21, 53) & MyPSOBJ.sendString("{eraseeof}" & New_BR_Emit)
        'new PO Emit DC
        RC = MyPSOBJ.setcursorlocation(22, 53) & MyPSOBJ.sendString("{eraseeof}" & New_DC_Emit)
        'new BR_FM
        RC = MyPSOBJ.setcursorlocation(21, 70) & MyPSOBJ.sendString("{eraseeof}" & New_BR_FM)
        'new DC-FM
        RC = MyPSOBJ.setcursorlocation(22, 70) & MyPSOBJ.sendString("{eraseeof}" & New_DC_FM)
        'new MBEC
        RC = MyPSOBJ.setcursorlocation(18, 75) & MyPSOBJ.sendString("{eraseeof}" & New_MBEC)
        'new MB
        RC = MyPSOBJ.setcursorlocation(19, 53) & MyPSOBJ.sendString("{eraseeof}" & New_MB)
        'new HQ
        RC = MyPSOBJ.setcursorlocation(19, 23) & MyPSOBJ.sendString("{eraseeof}" & New_HQ)
        'new No-SupS
        RC = MyPSOBJ.setcursorlocation(11, 69) & MyPSOBJ.sendString("{eraseeof}" & New_No_SupS)
        'new SIMS
        RC = MyPSOBJ.setcursorlocation(22, 23) & MyPSOBJ.sendString("{eraseeof}" & New_SIMS)
        'new Last_Update - This field can't be updated
        'rc = MyPSOBJ.setcursorlocation(7, 72)& MyPSOBJ.sendString("{eraseeof}" & New_Last_Update)
        'new Review_Update
        RC = MyPSOBJ.setcursorlocation(7, 18) & MyPSOBJ.sendString("{eraseeof}" & New_Review_Update)
        'new Review_By - This field can't be updated
        'rc = MyPSOBJ.setcursorlocation(22, 53)& MyPSOBJ.sendString("{eraseeof}" & New_Review_By)
        'new No_PO$
        RC = MyPSOBJ.setcursorlocation(14, 69) & MyPSOBJ.sendString("{eraseeof}" & New_No_PO$)
        'new Min_PO$
        RC = MyPSOBJ.setcursorlocation(17, 69) & MyPSOBJ.sendString("{eraseeof}" & "{enter}")
        RC = MyPSOBJ.setcursorlocation(17, 69) & MyPSOBJ.sendString(New_Min_PO$)
        'new GPC
        RC = MyPSOBJ.setcursorlocation(20, 74) & MyPSOBJ.sendString("{eraseeof}" & New_GPC)
        'Back out of the FM19 screen
        RC = MyPSOBJ.sendString("{enter}" & "{enter}" & "{PF12}")
        
        'Cells(r, 1).Activate
        Cells(r, 43) = "Changed"
        
        r = r + 1
    
    
    
    'Something like this, but this doesn't work.
    'Range(r,42").Value = Array(LocationNo, MFGID, Supplier_Name, Reassigned, Add1, ADD2, ADD3, City, _
    State, Zip, Zip4, Country, Lan, Phone1, Phone2, Fax, CA_US$, MX_US$, WebSite1, WebSite2, _
    Attention, AP_No, VFP, A_I, Sup_Con, FaxC, EDIC, BR_Emit, DC_Emit, BR_FM, DC_FM, MBEC, MB, _
    HQ, No_SupS, SIM, Last_Update, Review_Date, Review_By, No_PO$, Min_PO$, GPC)
       
    'Instead of this
    'IS THERE A WAY TO MAKE THIS AN ARRAY
    'START OF ARRAY
    LocationNo = Cells(r, 1).Value
    New_MFGID = Cells(r, 2).Value
    New_Supplier_Name = Cells(r, 3).Value
    New_Reassigned = Cells(r, 4).Value
    New_ADD1 = Cells(r, 5).Value
    New_ADD2 = Cells(r, 6).Value
    New_ADD3 = Cells(r, 7).Value
    New_City = Cells(r, 8).Value
    New_State = Cells(r, 9).Value
    New_Zip = Cells(r, 10).Value
    New_Zip4 = Cells(r, 11).Value
    New_Country = Cells(r, 12).Value
    New_Lan = Cells(r, 13).Value
    New_Phone1 = Cells(r, 14).Value
    New_Phone2 = Cells(r, 15).Value
    New_Fax = Cells(r, 16).Value
    New_CA_US$ = Cells(r, 17).Value
    New_MX_US$ = Cells(r, 18).Value
    New_Website1 = Cells(r, 19).Value
    New_Website2 = Cells(r, 20).Value
    New_Attention = Cells(r, 21).Value
    New_APNo = Cells(r, 22).Value
    New_VFP = Cells(r, 23).Value
    New_A_I = Cells(r, 24).Value
    New_Sup_Con = Cells(r, 25).Value
    New_FAX_Cap = Cells(r, 26).Value
    New_EDI_Cap = Cells(r, 27).Value
    New_BR_Emit = Cells(r, 28).Value
    New_DC_Emit = Cells(r, 29).Value
    New_BR_FM = Cells(r, 30).Value
    New_DC_FM = Cells(r, 31).Value
    New_MBEC = Cells(r, 32).Value
    New_MB = Cells(r, 33).Value
    New_HQ = Cells(r, 34).Value
    New_No_SupS = Cells(r, 35).Value
    New_SIMS = Cells(r, 36).Value
    New_Last_Update = Cells(r, 37).Value
    New_Review_Update = Cells(r, 38).Value
    New_Review_By = Cells(r, 39).Value
    New_No_PO$ = Cells(r, 40).Value
    New_Min_PO$ = Cells(r, 41).Value
    New_GPC = Cells(r, 42).Value
    'End Array
    
    
    
    Wend
    
    Range("A1").Select
    
End Sub

Thanks,
Jeremy

RickXL · Aug 4, 2016

Hi,

I am going to approach this one step at a time just in case I am not understanding correctly.

I am not sure what MyPSOBJ is but I have replaced it with a Function that just adds the numbers together. This is so that I can test something without having access to your system and data etc.

First I used a Collection Object to store all the numbers you seem to be using. I added the column number of the preceding Cells command as well.
Once that has been created then an array is created that will accept the row data to be written to the worksheet.
After the loop has filled the array using MyPSOBJ and the Collection of arrays it outputs the whole row.
Then it continues round your While/Wend loop.

I hope you can see where to place the various parts of the code into your existing code.

Code:

Option Base 0
Sub Test()
    Dim col         As Collection
    Dim arr         As Variant
    Dim item        As Variant
    Dim r           As Long
    Dim LocationNo  As String
    
    Set col = New Collection
    col.Add Array(2, 5, 6, 28)
    col.Add Array(3, 25, 5, 28)
    col.Add Array(4, 6, 8, 22)
    col.Add Array(5, 25, 9, 19)
    col.Add Array(6, 25, 10, 19)
    col.Add Array(7, 25, 11, 19)
    col.Add Array(8, 25, 12, 19)
    col.Add Array(9, 2, 12, 55)
    col.Add Array(10, 8, 12, 65)
    col.Add Array(11, 4, 12, 76)
    col.Add Array(12, 25, 13, 19)
    col.Add Array(13, 1, 9, 69)
    col.Add Array(14, 20, 15, 8)
    col.Add Array(15, 20, 15, 35)
    col.Add Array(16, 20, 15, 60)
    col.Add Array(17, 1, 10, 69)
    col.Add Array(18, 1, 13, 69)
    col.Add Array(19, 40, 16, 16)
    col.Add Array(20, 40, 17, 16)
    col.Add Array(21, 25, 14, 19)
    col.Add Array(22, 6, 8, 72)
    col.Add Array(23, 1, 18, 23)
    col.Add Array(24, 1, 18, 49)
    col.Add Array(25, 1, 21, 23)
    col.Add Array(26, 1, 20, 23)
    col.Add Array(27, 1, 20, 53)
    col.Add Array(28, 3, 21, 53)
    col.Add Array(29, 3, 22, 53)
    col.Add Array(30, 1, 21, 70)
    col.Add Array(31, 1, 22, 70)
    col.Add Array(32, 5, 18, 75)
    col.Add Array(33, 1, 19, 53)
    col.Add Array(34, 1, 19, 23)
    col.Add Array(35, 1, 11, 69)
    col.Add Array(36, 1, 22, 23)
    col.Add Array(37, 8, 7, 72)
    col.Add Array(38, 8, 7, 18)
    col.Add Array(39, 8, 7, 41)
    col.Add Array(40, 1, 14, 69)
    col.Add Array(41, 8, 17, 69)
    col.Add Array(42, 1, 20, 74)
    
    ReDim arr(1 To 1, 2 To 42)
    
    '**** LOOP THROUGH LIST ****

    r = 2
    LocationNo = Cells(2, 1).Value
    While LocationNo <> ""
        'IS THERE A WAY TO MAKE THIS AN ARRAY
        'START OF ARRAY
        For Each item In col
            arr(1, item(0)) = MyPSOBJ_GetData(item(1), item(2), item(3))
        Next
        Cells(r, 2).Resize(, col.Count) = arr
        'END OF ARRAY

        r = r + 1
        LocationNo = Cells(r, 1).Value
    Wend
End Sub

Function MyPSOBJ_GetData(a, b, c)
    MyPSOBJ_GetData = a + b + c
End Function

Jeremy4110 · Aug 4, 2016

Hi Rick,

Thank you, I really appreciate you replying to my post. The first code I submitted pulls the data from our mainframe system and the second code uploads it back to the system after it has been updated. Honestly, I'm not sure what "MyPSOBJ" is. I know it is part of the code we use to at work to get Excel to talk Aviva so that we can pull data from the mainframe into excel to analyze and the re-load it, below is that code.

Cells(r, 2) = MyPSOBJ.GetData(5, 6, 28)
Here is what I understand everything to mean: In "Cells(r, 2)" r is the row that loops and updates and the 2 is the column
In "MyPSOBJ.GetData(5, 6, 28)" is part of the code tell Excel what and where to get the date. I this example the field is 5 characters long and is located on row 6 and column 28 on the mainframe screen.

Code:

Dim SessionName
Dim AvivaApp
Dim MySession
Dim MyPSOBJ
Sub Aviva_Activate()
    SessionName = "C:\MTOSYS\Aviva\AFD\Session1"
    Set AvivaApp = CreateObject("AVIVA.APPLICATION")
    Set MySession = AvivaApp.Sessions.Add(SessionName, False)
    Set MyPSOBJ = MySession.PS
    RC = MySession.SetSharing(3)
End Sub

What does "Option Base 0" mean? Please correct me is I am wrong because I'm not 100% sure I understand, but if am correct the complete first code should look like this;

Code:

Option Base 0
Sub Test()







    'Row Headings
    Range("A1:AP1").Value = Array("LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", "ADD3 - Notes", "City", _
    "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", "MX-US $", "Website - Notes", "Email - Notes", _
    "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", "EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", _
    "HQ", "No-SupS", "SIM", "Last Update", "Review Date", "Review By", "No PO $", "Min PO $", "GPC")
    Range("A1:AP1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("A:A,D:D").NumberFormat = "000000"
    Range("B:B,J:J,V:V,AK:AL").NumberFormat = "@"
    
    Aviva_Activate
    
    RC = MyPSOBJ.sendString("{pf5}")







    Dim col         As Collection
    Dim arr         As Variant
    Dim item        As Variant
    Dim r           As Long
    Dim LocationNo  As String
    
    Set col = New Collection
    col.Add Array(2, 5, 6, 28)
    col.Add Array(3, 25, 5, 28)
    col.Add Array(4, 6, 8, 22)
    col.Add Array(5, 25, 9, 19)
    col.Add Array(6, 25, 10, 19)
    col.Add Array(7, 25, 11, 19)
    col.Add Array(8, 25, 12, 19)
    col.Add Array(9, 2, 12, 55)
    col.Add Array(10, 8, 12, 65)
    col.Add Array(11, 4, 12, 76)
    col.Add Array(12, 25, 13, 19)
    col.Add Array(13, 1, 9, 69)
    col.Add Array(14, 20, 15, 8)
    col.Add Array(15, 20, 15, 35)
    col.Add Array(16, 20, 15, 60)
    col.Add Array(17, 1, 10, 69)
    col.Add Array(18, 1, 13, 69)
    col.Add Array(19, 40, 16, 16)
    col.Add Array(20, 40, 17, 16)
    col.Add Array(21, 25, 14, 19)
    col.Add Array(22, 6, 8, 72)
    col.Add Array(23, 1, 18, 23)
    col.Add Array(24, 1, 18, 49)
    col.Add Array(25, 1, 21, 23)
    col.Add Array(26, 1, 20, 23)
    col.Add Array(27, 1, 20, 53)
    col.Add Array(28, 3, 21, 53)
    col.Add Array(29, 3, 22, 53)
    col.Add Array(30, 1, 21, 70)
    col.Add Array(31, 1, 22, 70)
    col.Add Array(32, 5, 18, 75)
    col.Add Array(33, 1, 19, 53)
    col.Add Array(34, 1, 19, 23)
    col.Add Array(35, 1, 11, 69)
    col.Add Array(36, 1, 22, 23)
    col.Add Array(37, 8, 7, 72)
    col.Add Array(38, 8, 7, 18)
    col.Add Array(39, 8, 7, 41)
    col.Add Array(40, 1, 14, 69)
    col.Add Array(41, 8, 17, 69)
    col.Add Array(42, 1, 20, 74)
    
    ReDim arr(1 To 1, 2 To 42)
    
    '**** LOOP THROUGH LIST ****







    r = 2
    LocationNo = Cells(2, 1).Value
    While LocationNo <> ""







        RC = MyPSOBJ.WaitForString("FM18                       ", 1, 2)
        RC = MyPSOBJ.setcursorlocation(5, 21) & MyPSOBJ.sendString(LocationNo & "{enter}")
        
        Message = MyPSOBJ.GetData(32, 23, 2)
                If Message = "EM04-NO MATCHING DATA WAS FOUND." Then
                    LocationNo = ""
                    MFGID = "Invalid"
                Else
            RC = MyPSOBJ.WaitForString("FM19                 ", 1, 2)










        'IS THERE A WAY TO MAKE THIS AN ARRAY
        'START OF ARRAY
        For Each item In col
            arr(1, item(0)) = MyPSOBJ_GetData(item(1), item(2), item(3))
        Next
        Cells(r, 2).Resize(, col.Count) = arr
        'END OF ARRAY







        r = r + 1
        LocationNo = Cells(r, 1).Value
    Wend
End Sub



Function MyPSOBJ_GetData(a, b, c)
    MyPSOBJ_GetData = a + b + c
End Function

RickXL · Aug 5, 2016

Option Base 0
When you create an Array in VBA, for instance in a statement like this:

Code:

col.Add Array(2, 5, 6, 28)

the Array elements are usually numbered from 0 to 3. If you use Option Base 1, the Array indices would be 1 to 4 instead. In this case I added Option Base 0 just to make sure that the default situation was in force. You can omit that line - but you can't replace it with Option Base 1 because lower down in the code I have hard-coded, for instance, item(0).

VBA is very inconsistent in its use of Arrays. Sometimes Option Base has an effect sometimes it does not, sometimes the Base will always be 0 whatever you do and other times it will always be 1. It all depends on how you created the Array.

I changed the PSOBJ reference so that I could make something work for testing purposes. You will need to use it the same way you did before so the loop should look like this:

Rich (BB code):

        For Each item In col
            arr(1, item(0)) = MyPSOBJ.GetData(item(1), item(2), item(3))
        Next

The Function I included at the end can be deleted as you will not be using it.

Your PSOBJ will be some special-purpose code that has been written for you. As it is specific to you I cannot test it. That is why I had to put in a workaround so that I could get something working even without having access to all the necessary software.

Regards,

Jeremy4110 · Aug 5, 2016

I'm not sure if this helps, but here are the FM18 and FM19 screen shots. In Red font I have listed the column numbers in the fields where the data is coming from on the mainframe screen.

RickXL · Aug 5, 2016

Sorry, but you will need to post any pictures to a place where they can be found on the Internet. For instance, DropBox, OneDrive, BitBucket , Google Drive etc.

Your links are just to your C: drive - to which I don't have access.

Anyway, does your new code work? Or not?

Regards,

Jeremy4110 · Aug 5, 2016

Ok, trying to paste and image didn't work, maybe this will'

FM18 Supplier Location Lookup *=Notebook

To search for a supplier location, type the information and Enter.

Location Number.. 1_____ Location Name.. _________________________
Manufacturer No.. _____ Owning MI Loc.. ____ Valid to Purchase.. _
------------------------------------------------------------------------------
Tab to the line to be referenced and choose the desired function key.

-Mfr- SupLoc --------- Name ---------- ------ City ----- St A S N V M Reasgn

And

FM19 View/Update/Add Supplier Location

Type the required Supplier Location information and press Enter to process.

Supplier Location Name... 2________________________ Location Number.: 1_______
Manufacturer Number...... 3____ Owning MI Loc...: CORP
Reviewed Date.. 38______ Reviewed by.. 39______ Last Update.....: 37______
Reassigned to Sup.. 4_____ A/P Supplier No.. 22____
Supplier Address 5________________________ Language Type (E/F/S) 13
6________________________ Canada/USA Vendor.... 17 (Y/N)
7________________________ Non Supported Sup.... 35 (Y/N)
City.. 12_______________________ State.. 9_ Zip.. 10______ - 11__
CD __ Country.. 12_______________________ Mexico/USA Vendor.... 18 (Y/N)
Attention.. 21_______________________ No PO Dollar Minimum. 40 (Y/N)
Phone 14__________________ Phone 15__________________ Fax 16__________________
Internet ID.. 19______________________________________
20______________________________________ PO Min $.. 41______.00
Valid for Purchasing 23 (Y/N) Active/Inactive 24 (A/I) MBE Certified... 32___
Headquarters........ 34 (Y/N) Minority Business.. 33 NOT MINORITY OWNED
FAX Capable.........26 (Y/N) EDI Capable........ 27 (Y/N) GPC UPS ACCT 42 (P/ )
Supplier Connect.... 25 (Y/N) PO XMIT Method Br.. 28_ Force Method 30 (Y/N)
SIM Expediting...... 36 (Y/N) PO XMIT Method DC.. 29_ Force Method 31 (Y/N)

RickXL · Aug 5, 2016

Thanks for the information but I do not actually need it.

What I am hoping for now is that you test out your new code and let me know if it works.

If it doesn't then tell me what the problem is and I will see if I can fix it.
If it does work then I can move on to your second problem.

Thanks,

Jeremy4110 · Aug 5, 2016

No, it doesn't work. I get an error message. "Run-time error'13': Type mismatch

Jeremy4110 · Aug 5, 2016

I'm sorry. It does work. I missed the part with you told me to get rid of the function.

Need help with a "Cells(r, 2) = MyPSOBJ.GetData(5, 6, 28)" Array and a "LocationNo = Cells(r, 1).Value" Array

Jeremy4110

Board Regular

Excel Facts

RickXL

MrExcel MVP

Jeremy4110

Board Regular

RickXL

MrExcel MVP

Jeremy4110

Board Regular

RickXL

MrExcel MVP

Jeremy4110

Board Regular

RickXL

MrExcel MVP

Jeremy4110

Board Regular

Jeremy4110

Board Regular

Similar threads

Forum statistics

Share this page

Need help with a "Cells(r, 2) = MyPSOBJ.GetData(5, 6, 28)" Array and a "LocationNo = Cells(r, 1).Value" Array

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock