Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Trouble getting Macro to Loop 1

Status
Not open for further replies.

link99sbc

Technical User
Apr 8, 2009
141
US
I'm trying to get this macro to loop a specified
number of times. I tried some examples in Excel help
but none worked. I have over 40,000 rows on the
spreadsheet. I want it to loop 25 or 50 or maybe 100
times starting on the ActiveCell.

This code works fine (1 row at a time)

Sub Check()


ActiveCell.Offset(1, 0).Activate
Selection.Copy

Dim Sessions As Object
Dim System As Object
Set System = CreateObject("EXTRA.System")
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
Set Field = System.ActiveSession.Screen.Area(3, 8, 3, 16)
Set Field1 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field2 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field3 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field4 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Field.Select
Field.Delete
Field.Value = ActiveCell

SendKeys "%{TAB}"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.MoveTo 3, 24
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("081")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("<Enter>")
Do While Sess0.Screen.OIA.Xstatus <> 0
DoEvents
Loop
ActiveCell.Offset(0, 1) = Field1.Value

Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.MoveTo 3, 24
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("082")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("<Enter>")
Do While Sess0.Screen.OIA.Xstatus <> 0
DoEvents
Loop
ActiveCell.Offset(0, 2) = Field2.Value

Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.MoveTo 3, 24
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("083")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("<Enter>")
Do While Sess0.Screen.OIA.Xstatus <> 0
DoEvents
Loop
ActiveCell.Offset(0, 3) = Field3.Value

Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.MoveTo 3, 24
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("084")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("<Enter>")
Do While Sess0.Screen.OIA.Xstatus <> 0
DoEvents
Loop
ActiveCell.Offset(0, 4) = Field4.Value




End Sub
 



Hi,
I have over 40,000 rows on the
spreadsheet. I want it to loop 25 or 50 or maybe 100
times...
Why, to limit the processing time? Use your AutoFilter.

Your code does not make sense as you are loading the same values in Field1, Field2, Field3, Field4.

Please explain your sheet structure.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Not familiar with autofilter
I only want to review maybe 100 at a time.
The fields are for 4 different pages
The macro brings up 081 then 082 then 083 and 084
The data I need is in the same position on each page.
I would just like it to loop for whatever number I
specify.
Thanks for your time.
 


And the LAST request?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I just like to start on the Active Cell.
It's what I can understand. Just learning.
The macro puts the data on the same row next to the
Active Cell then moves down 1 row to make that
the active cell (which are account numbers). I can use the same macro format for
many different projects without worring about what
column or row to start on.

Only the names are changed
to protect the innocent!
 



Sheet structure PLEASE!


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Field Field1 Field2 Field3 Field4
[ ColA ] [ ColB ] [ ColC ] [ ColD ] [ ColE ]
1234566 081 data 082 data 083 data 084 data
1234567 081 data 082 data 083 data 084 data
1234568 081 data 082 data 083 data 084 data
1244569 081 data 082 data 083 data 084 data

Is this what you mean?
 



Is the VALUE in column A used in the logic for the screen in Extra?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Yes this is the account number

Set Field = System.ActiveSession.Screen.Area(3, 8, 3, 16)
Field.Value = ActiveCell

which would be the Active cell in column A
which has all the account numbers.

BTY
each row of account numbers in column A
(1234567) is 7 digits. Any idea how to split
them like (123 4567) so I can do the whole
column like that???
 


Ok.

Let's say you're starting on row 3, where the acct nbr is 1234568.

how do you get the screen that has THAT acct nbr???

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
ActiveCell.Offset(1, 0).Activate 'Moves down 1 row and makes the cell Active
'Selection.Copy 'Don't need this line

Dim Sessions As Object
Dim System As Object
Set System = CreateObject("EXTRA.System")
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
Set Field = System.ActiveSession.Screen.Area(3, 8, 3, 16)
Set Field1 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field2 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field3 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Set Field4 = System.ActiveSession.Screen.Area(4, 75, 4, 78)
Field.Select
Field.Delete
Field.Value = ActiveCell 'This puts the Account number on the extra screen (Active Session)
'in the area specified by "Set Field". The value of Activecell is the
'account number

SendKeys "%{TAB}" 'This is Alt+Tab back to the Active session.
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.MoveTo 3, 24
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("081") 'Enters the page number
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys ("<Enter>")
Do While Sess0.Screen.OIA.Xstatus <> 0
DoEvents
Loop
ActiveCell.Offset(0, 1) = Field1.Value 'This gets the value of position 4,75,4,78 and puts it in ColB
 
So to start on row 3
I would make row 2 Active first
because "ActiveCell.Offset(1, 0).Activate"
moves down.
I could probably put this at the end
and use ActiveCell.Activate" At the beginning.
 
something like this...
Code:
Sub Check()
    Dim Sessions As Object
    Dim System As Object
    Dim Sess0 As Object
    Dim oScrn As Object
    
    Dim lRowCount, lOff As Long, iCol As Integer

    Set System = CreateObject("EXTRA.System")
    Set Sess0 = System.ActiveSession
    Set oScrn = Sess0.Screen
    
    lRowCount = InputBox("How many rows to process?")
    ActiveCell.Offset(1, 0).Activate
    
    If lRowCount > 0 Then
        Do While lOff <= lRowCount
            Sess0.oScrn.PutString ActiveCell.Offset(lOff, 0), 3, 8  'acctnbr
            For iCol = 1 To 4
                Sess0.oScrn.PutString "08" & iCol, 3, 24            '081-084
                Sess0.oScrn.MoveRelative 1, 1, 1
                Sess0.oScrn.SendKeys ("<Enter>")
                Do Until Sess0.oScrn.WaitForCursor(3, 24)
                    DoEvents
                Loop
                ActiveCell.Offset(lOff, iCol) = _
                    Sess0.oScrn.Area(4, 75, 4, 78).Value
            Next
            lOff = lOff + 1
        Loop
    End If

    Set oScrn = Nothing
    Set Sess0 = Nothing
    Set System = Nothing
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
doesn't like this line
Sess0.oScrn.PutString ActiveCell.Offset(lOff, 0), 3, 8 'acctnbr
 


try this...
Code:
Sess0.oScrn.PutString ActiveCell.Offset(lOff, 0).Value, 3, 8  'acctnbr

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 



1. Where is your VBA code located EXACTLY?

2. Exactly what is the error message?

3. Please post the code you are presently running.

Please answer all three questions?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
This spreedsheet module1
Run Time error "438"
Object doesn't support this property or method

Sub Checks()
Dim Sessions As Object
Dim System As Object
Dim Sess0 As Object
Dim oScrn As Object

Dim lRowCount, lOff As Long, iCol As Integer

Set System = CreateObject("EXTRA.System")
Set Sess0 = System.ActiveSession
Set oScrn = Sess0.Screen

lRowCount = InputBox("How many rows to process?")
ActiveCell.Offset(1, 0).Activate

If lRowCount > 0 Then
Do While lOff <= lRowCount
Sess0.oScrn.PutString ActiveCell.Offset(lOff, 0).Value, 3, 8 'acctnbr
For iCol = 1 To 4
Sess0.oScrn.PutString "08" & iCol, 3, 24 '081-084
Sess0.oScrn.MoveRelative 1, 1, 1
Sess0.oScrn.SendKeys ("<Enter>")
Do Until Sess0.oScrn.WaitForCursor(3, 24)
DoEvents
Loop
ActiveCell.Offset(lOff, iCol) = _
Sess0.oScrn.Area(4, 75, 4, 78).Value
Next
lOff = lOff + 1
Loop
End If

Set oScrn = Nothing
Set Sess0 = Nothing
Set System = Nothing
End Sub

 


Sorry, I had the session object AND the screen object, rather than just the screen object...
Code:
Sub Checks()
    Dim Sessions As Object
    Dim System As Object
    Dim Sess0 As Object
    Dim oScrn As Object
    
    Dim lRowCount, lOff As Long, iCol As Integer

    Set System = CreateObject("EXTRA.System")
    Set Sess0 = System.ActiveSession
    Set oScrn = Sess0.Screen
    
    lRowCount = InputBox("How many rows to process?")
    ActiveCell.Offset(1, 0).Activate
    
    If lRowCount > 0 Then
        Do While lOff <= lRowCount
            oScrn.PutString ActiveCell.Offset(lOff, 0).Value, 3, 8  'acctnbr
            For iCol = 1 To 4
                oScrn.PutString "08" & iCol, 3, 24            '081-084
                oScrn.MoveRelative 1, 1, 1
                oScrn.SendKeys ("<Enter>")
                Do Until oScrn.WaitForCursor(3, 24)
                    DoEvents
                Loop
                ActiveCell.Offset(lOff, iCol) = _
                    oScrn.Area(4, 75, 4, 78).Value
            Next
            lOff = lOff + 1
        Loop
    End If

    Set oScrn = Nothing
    Set Sess0 = Nothing
    Set System = Nothing
End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
When I run it Excel just locks up
I have to go to Task Manager to close it.

Thanks for the time.
I'll try again tomorrow.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top