How Do I Switch a Value and Repeat an Action?

[kc27]

I inherited an Excel file that interacts and copies data from screens of mainframe application. The mainframe application's screens were updated recently, causing a macro in the Excel file to fail. I know you cannot see the mainframe screens, but I was hoping someone could give me some guidance on correcting how the macro behaves.

The Excel file has two tabs:
The macro is supposed to pull data from a mainframe screen for region 37 and put in the first tab , then essentially repeat the process but this time pulling data for region 30 and putting it in the second tab.

I am stuck in two places. In this excerpt below, it looks like a value is created called "regn",then 3 lines later it uses that value in this line SC1.PutString regn, 2, 15

From this code, what value is the macro capturing? I can see from the mainframe screen the region is numbered 37,and if the user was using the mainframe manually, they would place their cursor next to the menu row that is labeled #37 and click enter. But I do not see in this code how the author determined that regn = #37, or how SC1.PutString regn, 2, 15 tells the macro to use the value of 37.

I did change the code to SC1.PutString "37", 2, 41, and that worked, but only partially, because at some point the macro is supposed to run the mainframe region 30 screen, and pull the data from that screen into the second tab of the worksheet. Instead it puts Region 37 data in the second tab, too.

Any ideas would be appreciated. I am not a VBA programmer, and have spent a week getting the Macro to run, but only partially.

Macro Excerpt Here:

Sub BT_Run_Region(ByVal regn As String, tabNum As Integer)
Dim WSR As Worksheet
Dim lastRow As Long
'navigate down to SKU maint screen ----------------
SC1.PutString regn, 2, 15
SC1.SendKeys "<ENTER>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(5, 30, 9) = "AVAILABLE" Then
MsgBox "Script could not navigate to the Application Menu for " & regn & ". Processing skipped for this region.",


Entire Macro Here:

Dim EXA As ExtraSystem
Dim EX1 As ExtraSession
Dim SC1 As ExtraScreen
Dim WB1 As Workbook
Dim WSC As Worksheet, WSB As Worksheet, WSE As Worksheet
Public Const COL_SKU = 1
Public Const COL_ZERO = 2
Public Const COL_NEWBR = 3
Public Const COL_NEWOUTL = 4
Public Const COL_NEWPACK = 5
Public Const COL_NEWMIN = 6
Public Const COL_MSG = 8
Public Const R_TITLE = 2

Function BT_Prevalidate()
Dim WSV As Worksheet
BT_Prevalidate = False
For ws = 1 To 3
Set WSV = ThisWorkbook.Worksheets(ws)
For r = R_TITLE + 1 To 5000
If Val(WSV.Cells(r, COL_SKU)) > 0 Then
newOUTL = WSV.Cells(r, COL_NEWOUTL)
newPack = WSV.Cells(r, COL_NEWPACK)
newMin = WSV.Cells(r, COL_NEWMIN)
If newPack > 0 Then
If newOUTL Mod newPack <> 0 Then
MsgBox "Pack size in row " & r & " on tab " & Worksheets(ws).Name & " not divisible into OUTL"
Exit Function
End If
End If
If newMin > 0 Then
If newOUTL Mod newMin <> 0 Then
MsgBox "New Min in row " & r & " on tab " & Worksheets(ws).Name & " not divisible into OUTL"
Exit Function
End If
End If
If UCase(WSV.Cells(r, COL_ZERO)) = "Y" And UCase(WSV.Cells(r, COL_NEWBR)) = "Y" Then
MsgBox "Row " & r & ". Zero Flag and Brass Flag cannot both be 'Y'."
Exit Function
End If
End If
Next r
Next ws
BT_Prevalidate = True
End Function

Sub BT_RunRepl()
Set WB1 = ThisWorkbook
'Precheck ----------------------------------------
'If WB1.Worksheets.Count <> 3 Then MsgBox "This XL workbook does not have 3 worksheets", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(1).Name <> "PCCICST0" Then MsgBox "Expected Tab1 name to be PCCICST0. Fix and retry.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(2).Name <> "PBCICST0" Then MsgBox "Expected Tab2 name to be PBCICST0. Fix and retry.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
'If WB1.Worksheets(3).Name <> "PECICST0" Then MsgBox "Expected Tab3 name to be PECICST0. Fix and retry.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(1).Cells(R_TITLE, COL_SKU) <> "SKU" Then MsgBox "Tab1 - Cannot verify SKU column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(2).Cells(R_TITLE, COL_SKU) <> "SKU" Then MsgBox "Tab2 - Cannot verify SKU column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
'If WB1.Worksheets(3).Cells(R_TITLE, COL_SKU) <> "SKU" Then MsgBox "Tab3 - Cannot verify SKU column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(1).Cells(R_TITLE, COL_NEWOUTL) <> "NEW OUTL" Then MsgBox "Tab1 - Cannot verify New OUTL column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
If WB1.Worksheets(2).Cells(R_TITLE, COL_NEWOUTL) <> "NEW OUTL" Then MsgBox "Tab2 - Cannot verify New OUTL column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
'If WB1.Worksheets(3).Cells(R_TITLE, COL_NEWOUTL) <> "NEW OUTL" Then MsgBox "Tab3 - Cannot verify New OUTL column.", vbOKOnly + vbCritical, "Pre-Check Error": Exit Sub
'precheck pack size and min are multiples of the outl
If Not BT_Prevalidate Then Exit Sub
'Connect to Extra! --------------------------------
Set WSC = WB1.Worksheets(1)
Set WSB = WB1.Worksheets(2)
'Set WSE = WB1.Worksheets(3)

Set EXA = CreateObject("Extra.System")
If EXA.Sessions.Count = 0 Then
Set EX1 = EXA.Sessions.Open("BT-PRD1.edp")
Else
Set EX1 = EXA.ActiveSession
End If
EX1.Visible = True
Set SC1 = EX1.Screen
Do Until SC1.WaitHostQuiet(5000): Loop
'make sure we're on the right screen ---------------
If Not SC1.GetString(1, 59, 5) = "TUBES" Then
MsgBox "Extra! session is not at the MAI Main Menu screen. Set mainframe to that screen and retry", vbOKOnly + vbCritical, "Not On Correct Mainframe Screen "
GoTo cleanup
End If
'process each region tab ----------------------------
WSC.Range(WSC.Cells(R_TITLE + 1, COL_MSG), WSC.Cells(5000, COL_MSG)).ClearContents: WSC.Activate: BT_Run_Region "PCCICST0", 1
WSB.Range(WSB.Cells(R_TITLE + 1, COL_MSG), WSB.Cells(5000, COL_MSG)).ClearContents: WSB.Activate: BT_Run_Region "PBCICST0", 2
'WSE.Range(WSE.Cells(R_TITLE + 1, COL_MSG), WSE.Cells(5000, COL_MSG)).ClearContents: WSE.Activate: BT_Run_Region "PECICST0", 3
WSC.Activate
cleanup:
Set SC1 = Nothing
Set EX1 = Nothing
Set EXA = Nothing
End Sub

Sub BT_Run_Region(ByVal regn As String, tabNum As Integer)
Dim WSR As Worksheet
Dim lastRow As Long
'navigate down to SKU maint screen ----------------
SC1.PutString regn, 2, 15
SC1.SendKeys "<ENTER>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(5, 30, 9) = "AVAILABLE" Then
MsgBox "Script could not navigate to the Application Menu for " & regn & ". Processing skipped for this region.", vbOKOnly + vbCritical, "Mainframe Screen Error"
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
Exit Sub
End If
SC1.PutString "BIGTICKT", 3, 42
SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(1, 33, 8) = "FUNCTION" Then
MsgBox "Script could not navigate to the Function Menu for Big Ticket region " & regn & ". Processing skipped for this region.", vbOKOnly + vbCritical, "Mainframe Screen Error"
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
Exit Sub
End If
SC1.PutString "002", 3, 44
SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(2, 18, 8) = "SKU MAIN" Then
MsgBox "Script could not navigate to the applciation screen for Function 02 in region " & regn & ". Processing halted - Check screen for possible cause.", vbOKOnly + vbCritical, "Mainframe Screen Error"
End If
Set WSR = ThisWorkbook.Worksheets(tabNum)
'determine last row in this tab -----------------------
For r = R_TITLE + 1 To 5000
If Val(WSR.Cells(r, COL_SKU)) > 0 Then lastRow = r
Next r
'SKU processing loop ----------------------------------
For r = R_TITLE + 1 To lastRow
If WSR.Cells(r, COL_SKU) > 0 Then
'If Val(WSR.Cells(r, COL_OLDOUTL)) + Val(WSR.Cells(r, COL_NEWOUTL)) > 0 Then
sku = WSR.Cells(r, COL_SKU)
SC1.MoveTo 9, 63, 1: SC1.SendKeys "<EraseEOF>"
SC1.PutString sku, 9, 63
SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF5>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(2, 19, 11) = "STYLE / SKU" Then
MsgBox "Error processing SKU " & sku & " at row " & r & " of tab " & tabNum & ". SKU was skipped.", vbOKOnly + vbCritical, "SKU Error"
WSR.Cells(r, COL_MSG) = "SKU Err - Skipped"
Else
If SC1.GetString(10, 22, 1) = "R" Then
currBRASS = SC1.GetString(20, 15, 1)
currZero = SC1.GetString(19, 71, 1)
newBRASS = UCase(WSR.Cells(r, COL_NEWBR))
newZero = UCase(WSR.Cells(r, COL_ZERO))
currOUTL = Val(Trim(SC1.GetString(20, 29, 5)))
newOUTL = Val(WSR.Cells(r, COL_NEWOUTL))
currPACK = Val(Trim(SC1.GetString(20, 50, 5)))
newPack = Val(WSR.Cells(r, COL_NEWPACK))
currMIN = Val(Trim(SC1.GetString(20, 75, 5)))
newMin = Val(WSR.Cells(r, COL_NEWMIN))
'are we turning sku on or off
If currBRASS = "Y" Then
If newBRASS = "N" Then 'then we are turning off
SC1.PutString "N", 20, 15: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set BRASS = "N"
'SC1.PutString "Y", 19, 71: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set Zero = "Y"
SC1.PutString newZero, 19, 71: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set Zero to user's entry
End If
Else 'currBRASS must be "N"
If newBRASS = "Y" Then 'we ar turning brass on
SC1.PutString "N", 19, 71: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set Zero = "N"
SC1.PutString "Y", 20, 15: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set BRASS = "Y"
Else
SC1.PutString newZero, 19, 71: SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop 'set Zero to user's entry
End If
End If
'if BRASS is still Y then update
If SC1.GetString(20, 15, 1) = "Y" Then
If currOUTL <> newOUTL Then
SC1.MoveTo 20, 29, 1: SC1.SendKeys "<EraseEOF>"
SC1.PutString newOUTL, 20, 29
End If
If currPACK <> newPack Then
SC1.MoveTo 20, 50, 1: SC1.SendKeys "<EraseEOF>"
SC1.PutString newPack, 20, 50
End If
If currMIN <> newMin Then
SC1.MoveTo 20, 75, 1: SC1.SendKeys "<EraseEOF>"
SC1.PutString newMin, 20, 75
End If
End If
SC1.SendKeys "<Enter>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF4>": Do Until SC1.WaitHostQuiet(100): Loop
If Not SC1.GetString(2, 18, 8) = "SKU MAIN" Then
MsgBox "Error navigating back to SKU Screen on SKU " & sku & " at row " & r & " of tab " & tabNum & ". Processing halted - Check screen for possible cause.", vbOKOnly + vbCritical, "Mainframe Screen Error"
Exit Sub
Else
WSR.Cells(r, COL_MSG) = "Updated"
End If
Else
WSR.Cells(r, COL_MSG) = "Not R status"
SC1.SendKeys "<PF4>": Do Until SC1.WaitHostQuiet(100): Loop
End If
End If
End If
DoEvents
Next r
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
SC1.SendKeys "<PF3>": Do Until SC1.WaitHostQuiet(100): Loop
End Sub

 

[SkipVought]

Hi,

You appear to have an Excel VBA program interacting with an Attachmate!Extra terminal emulator.

SC1.PutString regn, 2, 15

...is an Attachmate VB method, that places the value in regn on the active screen at row 2, column 15.

You need to look at the section of code 'process each region tab . There are three calls to the Function that uses regn. The first call is BT_Run_Region "PCCICST0", 1 where PCCICST0 is assigned to regn and tabNum is assigned 1. So maybe this is where you need to put whatever values you need.

BTW, this is not the way I'd be designing a procedure like this. DATA, like PCCICST0, 1 ought to be in a table and not buried in code.



Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[kc27]

Thanks - for interpreting this. The mainframe screens changed recently. I was able to fix part of the mapping that the macro is doing, but did not know where it was picking up the regn value. This should help.

The code was written years ago by someone who was mostly self-taught in VBA. They may not have been aware of best programming practices.

 

[kc27]

Just wanted to say thanks again for the guidance. The expert user who reported the problem with this macro was finally able to to test, and confirm that the changes made to the macro after getting direction from you, resolved the problem.

Just for my own knowledge, I understand how the macro processes the first worksheet using data from BT_Run_Region "PCCICST0", 1 - but where in the macro does it select the second worksheet and repeat the process for BT_Run_Region "PBCICST0", 2 ?

 

[SkipVought]

'process each region tab ----------------------------
WSC.Range(WSC.Cells(R_TITLE + 1, COL_MSG), WSC.Cells(5000, COL_MSG)).ClearContents: WSC.Activate: BT_Run_Region "PCCICST0", 1
WSB.Range(WSB.Cells(R_TITLE + 1, COL_MSG), WSB.Cells(5000, COL_MSG)).ClearContents: WSB.Activate: BT_Run_Region "PBCICST0", 2
'WSE.Range(WSE.Cells(R_TITLE + 1, COL_MSG), WSE.Cells(5000, COL_MSG)).ClearContents: WSE.Activate: BT_Run_Region "PECICST0", 3

Notice that 3 is commented out.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

I hope you got that change to my previous post. Sorry, I lost my place.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]