DEVHIDE
Login Or Sign up

VBA Loop Defined Range Every nth Row

734 Views Asked by At

Premise: I am automating a manual data entry process into a terminal emulation product (BlueZone) using VBA. As a front-end user I have limited commands and lift data from the screen (with a copy screen and paste into Excel) to make determinations and stop the run if an error is encountered. The data is related to warehouse inventory and there are compliance issues - so it is important there are checks to guarantee integrity.

I currently have a working loop, but I need it to iterate every 10 rows. In other words, I need it to:

1) Navigate to the associated emulation screen

2) Enter the header data

3) Enter 10 products with adjustment amounts - start at row 5

4) Commit the entry

5) Begin again at (1) at row 15

I have attempted without success:

For i = 1 to 3000 Step 10 '3000 same range defined as object in current for each

Screenshots of the system and user entry form:

Emulation Screen

Input and Screen Checks

Sub IISAB_DuuEet()

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value

'--------------------------------------BLOCK 1----------------------------------------------

'********BLOCK 1 must occur only when i=1 of 10********'

'Navigar a IISAB y preparate
bzhao.SendKey "<PF3>"
bzhao.Wait 0.2
bzhao.SendKey "IISAB"
bzhao.Wait 0.2
bzhao.SendKey "<ENTER>"
bzhao.Wait 0.2
bzhao.SendKey "A"
bzhao.Wait 0.2
bzhao.SendKey RC
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.2
bzhao.SendKey Julian
bzhao.Wait 0.2
bzhao.SendKey "<TAB><TAB><TAB><TAB>"

'--------------------------------------BLOCK 2----------------------------------------------

'********BLOCK 2 must occur for all i = 1 to 10********'

'Begin L00P on location>Prod>(+/-)>Qty 10x
For Each myLoc In myRange

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

Prod = myLoc.Offset(0, 1).Value
Adj_Dir = myLoc.Offset(0, 2).Value
Adj_Qty = myLoc.Offset(0, 3).Value


'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If

Next myLoc

'After 10th iteration -
'1) Commit inventory adjustments
'2) Start i=1 again with Block 1 and enter 10 more products

'--------------------------------------------------------------------------------------

End Sub

Attempt with Step 10 - I removed the working For Each.

Sub IISAB_DuuEet2()

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value

'--------------------------------------------------------------------------------------

'--------------------------------------------------------------------------------------

'Begin L00P on location>Prod>(+/-)>Qty 10x
For i = 1 To 3000 Step 10

myLoc = Cells(i, 0).Value 'DEBUG object define error

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

        If i = 1 Then 'Enter screen info AND first line

        bzhao.SendKey "<PF3>"
        bzhao.Wait 0.2
        bzhao.SendKey "IISAB"
        bzhao.Wait 0.2
        bzhao.SendKey "<ENTER>"
        bzhao.Wait 0.2
        bzhao.SendKey "A"
        bzhao.Wait 0.2
        bzhao.SendKey RC
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.2
        bzhao.SendKey Julian
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB><TAB><TAB><TAB>"


        Prod = myLoc.Offset(0, 1).Value
        Adj_Dir = myLoc.Offset(0, 2).Value
        Adj_Qty = myLoc.Offset(0, 3).Value


        'Begin adjusts
        bzhao.SendKey myLoc
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.5

        'Check product
        bzhao.Copy 32
        Range("I1").Select
        ActiveSheet.Paste
        bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("G2").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If


End If 'end i=1 if

        Prod = myLoc.Offset(0, 1).Value
        Adj_Dir = myLoc.Offset(0, 2).Value
        Adj_Qty = myLoc.Offset(0, 3).Value


        'Begin adjusts
        bzhao.SendKey myLoc
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.5

        'Check product
        bzhao.Copy 32
        Range("I1").Select
        ActiveSheet.Paste
        bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("G2").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If


Next i

'--------------------------------------------------------------------------------------

End Sub
vba loops emulation nested-loops bluezone
Original Q&A
1

There are 1 best solutions below

0
AKdelBosque On

I was able to solve the problem by:

(1) Sheet formula to create 1-10 counts in column F

=IF(F5=10,1,F5+1)

(2) Link with vlookup to the screen position in column H

(3) Column G interprets the screenshots 

=IFERROR(IF(SEARCH(B5,(IFERROR(VLOOKUP(F5,$H$11:$I$20,2,0),"")),1)>1,"PASS",""),"")

(3) If statements within the For Each to accommodate the iterations every 10 rows

Not the most eloquent, but the following code executed without incident:

'******************INVENTORY USER +++ IISAB ADJUSTMENT******************'
'                                                                       '
'                                                                       '
'                                                                       '
'           Userform to complete Bucket List counts and capture         '
'            adjustments with direction for entry into IISAB.           '
'                                                                       '
'                        1337___734|\/| 1|)-10-T                        '
'                                                                       '
'                        Code by: Adam Kowaleski                        '
'                                                                       '
'                                                                       '
'                                                                       '
'*******************************//X//***********************************'

Sub IISAB_DuuEet4()

'Clear output
Range("E5:E1005").Select
Selection.ClearContents

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian, kownt As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value


'-----------------------------------------------------------------*

'Begin L00P on location>Prod>(+/-)>Qty 10x
For Each myLoc In myRange

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

Prod = myLoc.Offset(0, 1).Value
Adj_Dir = myLoc.Offset(0, 2).Value
Adj_Qty = myLoc.Offset(0, 3).Value
Scrn_Pos = myLoc.Offset(0, 5).Value

If Scrn_Pos = 1 Then 'Include screen nav --------------------------* 1 *

'Navigar a IISAB y preparate
bzhao.SendKey "<PF3>"
bzhao.Wait 0.2
bzhao.SendKey "IISAB"
bzhao.Wait 0.2
bzhao.SendKey "<ENTER>"
bzhao.Wait 0.2
bzhao.SendKey "A"
bzhao.Wait 0.2
bzhao.SendKey RC
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.2
bzhao.SendKey Julian
bzhao.Wait 0.2
bzhao.SendKey "<TAB><TAB><TAB><TAB>"

'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>" 'Land on Product
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("EXE ERROR")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>" 'Land on Adj Qty
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Land on Adj Dir
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Land on new loc
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("PRODUCT DOES NOT MATCH")
                Exit For
                    End If

Else

'-----------------------------------------------------------* <> 1 *

'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>" 'Product
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("EXE ERROR")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Next myLoc
            myLoc.Offset(0, 4).Value = "ENTERED"

                If Scrn_Pos = 6 Then
                bzhao.Wait 0.2
                bzhao.SendKey "<CursorLeft>" 'BECAUSE YES EXE THREW THAT WRENCH
                bzhao.Wait 0.2
                End If

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("PRODUCT DOES NOT MATCH")
                Exit For
                    End If

                If Scrn_Pos = 10 Then 'Commit at 10 '----* = 10 *
                bzhao.Wait 0.2
                bzhao.SendKey "<ENTER>"
                bzhao.Wait 0.2
                bzhao.SendKey "Y"
                bzhao.SendKey "<ENTER>"
                bzhao.Wait 1
                bzhao.SendKey "<DELETE>"
                bzhao.Wait 0.2
                bzhao.SendKey "<DELETE>"
                bzhao.Wait 0.2
                End If


End If 'Scrn_Pos = 1

Next myLoc


End Sub

Related Questions in VBA

Related Questions in LOOPS

Related Questions in EMULATION

Related Questions in NESTED-LOOPS

Related Questions in BLUEZONE

Trending Questions

Popular # Hahtags

javascript python java c# php android html jquery c++ css ios sql mysql r reactjs node.js arrays c asp.net json

Popular Questions

.

Copyright © 2021 Jogjafile Inc.