VBA Loop Help - A Fresh one!

[sanantonio]

Hi All,

I'm trying to recycle a loop that @NateSC helped me with previously. This might sound premature but I only have limited testing time (4 hours on Wednesday afternoon) where I'll have access to the systems I need.

What it should do is loop through the data in the table below and "sendkey" it to a module within our client-specific software.

This list could be as many as 250 lines of entry or 1 or 2 lines of entry depending on the week and decisions made by other business divisions.

This is the code that I've adapted that I think will work (Like I say I can't test this until Wednesday). Can anyone see anything that'll go wrong?

Sub SFO_Entry()

Dim myAlo As Range
Dim myRow, myCount As Long
Dim myWindow As String
Dim myItem, myQuantity As Range
Dim mySlot As Variant
Dim hWnd As Long
Dim Row1 As Long, Row2 As Long, Num1 As Long, Counter1 As Long
Dim Item As Range, Items As Range
Dim ItemCode As String
Dim Window1 As String, Window2 As String, Window3 As String


If Cell Is Nothing Then

    'Select MDE Module
    Window1 = "[SFO000] - Store Forms Module - DB: USWH00" & Sheets("Cover").Range("J13").Value & "L (USWH00" & Sheets("Cover").Range("J13").Value & "L)  Schema: WAWIADM Role: R_WAWI"
    Window2 = "[SFO002] Store Claim Delivery"
    hWnd = FindWindow(vbNullString, Window1)
    SetForegroundWindow hWnd
    If hWnd > 0 Then
        Else
            MsgBox ("SFO Module cannot be found.")
            myCancel = "Cancel"
    Exit Sub
    End If


' Updated code below this point !!!
Dim numStores As Integer
Dim i As Integer
Dim j As Integer
Dim temp(10) As Variant
Dim ws As Worksheet
Dim myLastCol As Integer
Dim myFirstCol As Integer
Dim myLastRow As Integer
Dim myFirstRow As Integer
Dim myCurrentRow As Integer

    Set ws = ActiveSheet
    
    ' Finds first and last rows and columns with data
    myLastRow = ws.Cells(Rows.Count, 4).End(xlUp).Row
    myFirstRow = ws.Cells(myLastRow, 4).End(xlUp).Row
    myLastCol = ws.Cells(myFirstRow, Columns.Count).End(xlToLeft).Column
    myFirstCol = ws.Cells(myFirstRow, myLastCol).End(xlToLeft).Column
    
  
    'Loop 1, enters store, document number, document date
    For i = 1 To numStores
        
        
        'Store
        temp(1) = ws.Cells(myFirstRow, myFirstCol - 1 + i * 2).Value
        SendKeys temp(1)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Document Nr
        temp(2) = ws.Cells(myFirstRow + 3, myFirstCol - 1 + i * 2).Value
        SendKeys temp(2)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Picklist Nr
        temp(3) = ws.Cells(myFirstRow + 2, myFirstCol - 1 + i * 2).Value
        SendKeys temp(3)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Item
        temp(4) = ws.Cells(myFirstRow + 1, myFirstCol - 1 + i * 2).Value
        SendKeys temp(4)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Case Size
        temp(4) = ws.Cells(myFirstRow + 1, myFirstCol - 1 + i * 2).Value
        SendKeys temp(5)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Case Qty
        temp(4) = ws.Cells(myFirstRow + 1, myFirstCol - 1 + i * 2).Value
        SendKeys temp(6)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Units Qty
        temp(4) = ws.Cells(myFirstRow + 1, myFirstCol - 1 + i * 2).Value
        SendKeys temp(7)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        
        'Then inserts
        SendKeys ("{TAB}")
        SendKeys ("{TAB}")
        SendKeys (" ")
        Application.Wait (Now + TimeValue("00:00:01"))
        SendKeys ("{F3}")
          
    Next i

SendKeys ("{ESC}")
MsgBox "Action Complete"

End If
End Sub

Thanks in advance!

 

[NateSC]

A few quick things
1) you don't define numStores - it will just skip right past the loop.
2) you need to update the temp variable for Case Size (temp(5)), Case Qty (temp(6)), and Units Qty (temp(7)). All 3 of these say "temp(4) =" instead of their respective temp's.
3) after Item, do you need 2 tabs to skip the Item description column?
4) you show a number 8 over Credit, but you don't have that data in your chart and you don't show outputting that data. Just checking if you need the 8th field or not.
5) Your cell references for the temp's are not going to work. We were previously working with data that was in sets of columns. Now you are just pulling it straight off a row. The equations should be much simplier. I haven't tested it, but I think this is what you want:

temp(1) = ws.cells(myFirstRow+i , myFirstCol).value
temp(2)= ws.cells(myFirstRow+i , myFirstCol+1).value
temp(3)= ws.cells(myFirstRow+i , myFirstCol+2).value
temp(4)= ws.cells(myFirstRow+i , myFirstCol+3).value
temp(5)= ws.cells(myFirstRow+i , myFirstCol+4).value
temp(6)= ws.cells(myFirstRow+i , myFirstCol+5).value
temp(7)= ws.cells(myFirstRow+i , myFirstCol+6).value

You can try running this on a dummy set of data and outputting to another sheet in the same file instead of to the program.

 

[NateSC]

I think:

numStores = myLastRow - myfirstRow

 

[sanantonio]

A few quick things
1) you don't define numStores - it will just skip right past the loop.
2) you need to update the temp variable for Case Size (temp(5)), Case Qty (temp(6)), and Units Qty (temp(7)). All 3 of these say "temp(4) =" instead of their respective temp's.
3) after Item, do you need 2 tabs to skip the Item description column?
4) you show a number 8 over Credit, but you don't have that data in your chart and you don't show outputting that data. Just checking if you need the 8th field or not.
5) Your cell references for the temp's are not going to work. We were previously working with data that was in sets of columns. Now you are just pulling it straight off a row. The equations should be much simplier. I haven't tested it, but I think this is what you want:

temp(1) = ws.cells(myFirstRow+i , myFirstCol).value
temp(2)= ws.cells(myFirstRow+i , myFirstCol+1).value
temp(3)= ws.cells(myFirstRow+i , myFirstCol+2).value
temp(4)= ws.cells(myFirstRow+i , myFirstCol+3).value
temp(5)= ws.cells(myFirstRow+i , myFirstCol+4).value
temp(6)= ws.cells(myFirstRow+i , myFirstCol+5).value
temp(7)= ws.cells(myFirstRow+i , myFirstCol+6).value

You can try running this on a dummy set of data and outputting to another sheet in the same file instead of to the program.

Hi @NateSC thanks for coming back to me.

In the office today and trying to get this to work.

1). I've inserted thenumStores = myLastRow - myFirstRow
2). I'm not sure I understand?
3). Good spot, no the description column populates automatically from item number
4). For Number 8 on credit that is dealt with by the tab > tab > space at the end of the loop
5). I've updated it with your suggested.

Below is my code as it stands, I know there's some redundant code in there but can work on removing that once it's working. Currently the macro does nothing. It doesn't debug or error. You hit "play" and it just does absolutely nothing.

It was debugging in a couple places, namely: "If Cell is Nothing Then" and (What I presume) is the "End if" attached to it. I've apostrophe'd these out and that's left me with the macro that doesn't seem to do anything.

Any ideas?

Sub SFO_Entry()

Dim myAlo As Range
Dim myRow, myCount As Long
Dim myWindow As String
Dim myItem, myQuantity As Range
Dim mySlot As Variant
Dim hWnd As Long
Dim Row1 As Long, Row2 As Long, Num1 As Long, Counter1 As Long
Dim Item As Range, Items As Range
Dim ItemCode As String
Dim Window1 As String, Window2 As String
numStores = myLastRow - myFirstRow

'If Cell Is Nothing Then
'^ was giving error

    'Select SFO Module
    Window1 = "[SFO000] - Store Forms Module - DB: USWH00" & Sheets("Cover").Range("J13").Value & "L (USWH00" & Sheets("Cover").Range("J13").Value & "L)  Schema: WAWIADM Role: R_WAWI"
    Window2 = "[SFO002] Store Claim Delivery"
    hWnd = FindWindow(vbNullString, Window1)
    SetForegroundWindow hWnd
    If hWnd > 0 Then
        Else
            MsgBox ("SFO Module cannot be found.")
            myCancel = "Cancel"
    Exit Sub
    End If


Dim i As Integer
Dim j As Integer
Dim temp(10) As Variant
Dim ws As Worksheet
Dim myLastCol As Integer
Dim myFirstCol As Integer

Dim myCurrentRow As Integer

    Set ws = ActiveSheet
    numStores = myLastRow - myFirstRow
    ' Finds first and last rows and columns with data
    myLastRow = ws.Cells(Rows.Count, 4).End(xlUp).Row
    myFirstRow = ws.Cells(myLastRow, 4).End(xlUp).Row
    myLastCol = ws.Cells(myFirstRow, Columns.Count).End(xlToLeft).Column
    myFirstCol = ws.Cells(myFirstRow, myLastCol).End(xlToLeft).Column
    
  
    'Loop 1, enters store, document number, Picklist number, item, case size, qty case, qty units, enters
    For i = 1 To numStores
        
        
        'Store
        temp(1) = ws.Cells(myFirstRow + i, myFirstCol).Value
        SendKeys temp(1)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Document Nr
        temp(2) = ws.Cells(myFirstRow + i, myFirstCol + 1).Value
        SendKeys temp(2)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Picklist Nr
        temp(3) = ws.Cells(myFirstRow + i, myFirstCol + 2).Value
        SendKeys temp(3)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Item
        temp(4) = ws.Cells(myFirstRow + i, myFirstCol + 3).Value
        SendKeys temp(4)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Case Size
        temp(5) = ws.Cells(myFirstRow + i, myFirstCol + 4).Value
        SendKeys temp(5)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Case Qty
        temp(6) = ws.Cells(myFirstRow + i, myFirstCol + 5).Value
        SendKeys temp(6)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        'Units Qty
        temp(7) = ws.Cells(myFirstRow + i, myFirstCol + 6).Value
        SendKeys temp(7)
        SendKeys ("{TAB}")
        Application.Wait (Now + TimeValue("00:00:01"))
        
        'Then inserts
        SendKeys ("{TAB}")
        SendKeys ("{TAB}")
        SendKeys (" ")
        Application.Wait (Now + TimeValue("00:00:01"))
        'SendKeys ("{F3}")
          
    Next i

SendKeys ("{ESC}")
MsgBox "Action Complete"

'End If
'^Above was giving error
End Sub

 

[NateSC]

You need to move myNumStores equation down. It has to be after the program figures out myFirstRow and myLastRow. Then try stepping through the program using F8. You can make it step through line by line and use the Immediates or Watch Window to track you values.

 

[NateSC]

You need to move myNumStores equation down. It has to be after the program figures out myFirstRow and myLastRow. Then try stepping through the program using F8. You can make it step through line by line and use the Immediates or Watch Window to track you values.

 

[sanantonio]

Bingo! Saved me again, it's running great now.

For next level I need it to check whether Column E has any duplicates, and whether column L has any 6s, 11s, 12s. And return a message box if it finds any of these things. I've tried to recycle the 0 quantity check from the last macro but can't get it to work

 

[NateSC]

You just want a message box for these cases? Does it need to do anything else?

 

[NateSC]

If you just want to see if something is repeated, you can use CountIf. If you want to know WHERE it is repeated, you would need a loop or you would have to read the column into an array, search for the information, and return all the indexes where it occurs. The code just to check for this would be placed just below "temp(2)=..."

If Application.WorksheetFunction.CountIf(ws.Range("E" & myFirstRow & ":E" & myLastRow), temp(2)) > 1 Then MsgBox temp(2) & " is repeated"

OR if you want to keep the column somewhat flexible and you know it is always the second column:

If Application.WorksheetFunction.CountIf(ws.Range(Cells(myFirstRow, myFirstCol + 1), Cells(myLastRow, myFirstCol + 1)), temp(2)) > 1 Then MsgBox temp(2) & " is repeated"

For column L (D+8 columns) you could do something like:

testValue = ws.Cells(myFirstRow + i, myFirstCol + 8)
If testValue = 6 Or testValue = 11 Or testValue = 12 Then MsgBox "The value of " & testValue & " was found."

Again, this only shows a message box. You can add further code to make it do something else if you want.

 

[sanantonio]

Wow great thanks. I'll incorporate these in and test them when next in the office.

I'd need a Message Box and to end the sub if found?

Also whereabouts should the second check go?