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

J

Jeremy4110

Board Regular
Joined
Sep 26, 2015
Messages
70
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
 
Sort by date Sort by votes
Hi Rick,
Sorry about taking so long to get back with. I want to thank you for your help, I greatly appreciate it.
 
Upvote 0
It is faster, not as much faster as I had hoped. On average about 12-15 each time we use it. It also seems to be more stable. I really do applicate your help. Thank you again.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Asbestos_Jen
  • Solved
Speed up slow array index calculations
Replies
3
Views
188
Scott Huish
Scott Huish
J
  • Solved
Using LEFT Function On a Range Instead of A Single Cell Value
Replies
4
Views
267
Fluff
Fluff
A
  • Question Question
Data Selection Based on Closest Value [20% Tolerance]
Replies
1
Views
246
StephenCrump
S
P
  • Question Question
ListBox Click to textbox & delete row
Replies
0
Views
661
pure vito
P
E
  • Question Question
VBA code clean up
Replies
9
Views
704
mumps
mumps

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top