VBA Loop Help - A doozy for a Friday Afternoon!

[sanantonio]

Hi All,

I suck at loops. I can never get them to work. Ive been sat trying to recycle someone's loop for a couple hours and I can't get it to work

SO,

I need it to loop a Sendkey macro.

I work for a distributor, we have a system that requires the manual keying in of orders by a Human reading from a spreadsheet. Efficiency wise this is of course awful. I'm trying to automate this process.

I'm trying to get the loops to work with the data in the format that it comes to us, but if there's a recommendation that makes everything work but the data needs to be presented in a different format that can be arranged.

My macro needs to take this data and put it into this antiquated module:

Currently my code looks like:

(I've inserted comments using the ')

Sub testing2()

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

'Select MDE Module
Window1 = "[MDE000] - MDE Module - DB: USWH00" & Sheets("Cover").Range("J13").Value & "L (USWH00" & Sheets("Cover").Range("J13").Value & "L)  Schema: WAWIADM Role: R_WAWI"
Window2 = "[MDE007] Manual Picklist"
hWnd = FindWindow(vbNullString, Window1)
SetForegroundWindow hWnd
If hWnd > 0 Then
Else
MsgBox ("MDE Module cannot be found.")
myCancel = "Cancel"
Exit Sub
End If
 
'Loop 1, enters store, order area, date, and supplier
'Currently as you can see in the screenshot above are separated by words, if a different format is necessary please recommend! I can easily build something that reformats.

        'Store
        SendKeys ActiveSheet.Range("L4").Value
        SendKeys ("{TAB}")
        'Order Area
        SendKeys ActiveSheet.Range("L6").Value
        SendKeys ("{TAB}")
        'Date
        SendKeys ActiveSheet.Range("L7").Value
        SendKeys ("{TAB}")
        'Supplier
        SendKeys ActiveSheet.Range("L5").Value
        SendKeys ("{TAB}")
        
'Loop 2, Then loops through items and quanities

        'Items - Currently this just runs for the first 2 items. The sendkeys need 2 happen after each item / quantity is entered but the cell reference needs 2 loop
        
        SendKeys ActiveSheet.Range("K9").Value 'First item code
        SendKeys ("{TAB}")
        SendKeys ("{TAB}")
        SendKeys ActiveSheet.Range("L9").Value 'First item quantity
        SendKeys ("{TAB}")
          SendKeys (" ")
        SendKeys ActiveSheet.Range("K10").Value 'Second item code
        SendKeys ("{TAB}")
        SendKeys ("{TAB}")
        SendKeys ActiveSheet.Range("L10").Value 'Second item quantity
         SendKeys ("{TAB}")
           SendKeys (" ")
                 
         'Saves once all items are complete END OF LOOP 2
      SendKeys ("{F3}")
      
      '<> Starts next Store/Supplier/OrderArea/Date
      
      'Back in2 Loop 2.

End Sub

There's a lot of redundant code in there, because like I say I'm trying to retrofit another macro.

Is this double loop process possible? Where it'll loop thru store/order area/supplier/date, then loop through items, then jump to the next store/order area/supplier/date, then loop through items, then jump to the next store/order area/supplier/date etc. ?

Anyone able to help me out?

 

[NateSC]

If you have a column that you know will have some kind of data in it, you can change the "1" in the following lines to that column number:

myLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
myFirstRow = ws.Cells(myLastRow, 1).End(xlUp).Row

Alternatively, if you know you will always have your data in row A, you could change the code to use that row to determine the first and last column and row. Again, you could change the "1" below to the row you know has data.

 ' Finds first and last rows and columns with data
    myLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    myFirstCol = ws.Cells(1, myLastCol).End(xlToLeft).Column
    myLastRow = ws.Cells(Rows.Count, myFirstCol).End(xlUp).Row
    myFirstRow = ws.Cells(myLastRow, myFirstCol).End(xlUp).Row

Alternatively alternative, you could just hard code the columns and rows (random numbers entered below):

 ' Finds first and last rows and columns with data
    myLastCol = 21
    myFirstCol = 12
    myLastRow = 2345689
    myFirstRow = 2345675

 

[sanantonio]

If you have a column that you know will have some kind of data in it, you can change the "1" in the following lines to that column number:

myLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
myFirstRow = ws.Cells(myLastRow, 1).End(xlUp).Row

Alternatively, if you know you will always have your data in row A, you could change the code to use that row to determine the first and last column and row. Again, you could change the "1" below to the row you know has data.

 ' Finds first and last rows and columns with data
    myLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    myFirstCol = ws.Cells(1, myLastCol).End(xlToLeft).Column
    myLastRow = ws.Cells(Rows.Count, myFirstCol).End(xlUp).Row
    myFirstRow = ws.Cells(myLastRow, myFirstCol).End(xlUp).Row

Alternatively alternative, you could just hard code the columns and rows (random numbers entered below):

 ' Finds first and last rows and columns with data
    myLastCol = 21
    myFirstCol = 12
    myLastRow = 2345689
    myFirstRow = 2345675

Hey,

Thanks for coming back to me!

Unfortunately I can't get any of these solutions to work.

The first gives me the error you built in about "The number of columns with store data was not an even number"

The second is one I've tried in a couple different ways, but it either will send blanks into the module or give me the same error as above.

And the final one gives me a debug overflow error :-/

I'm sure it's only me doing something wrong, thanks for trying I'll keep trying!

 

[NateSC]

No problem. Where does your data start? What row and what column? Is it always consistent or can it change either starting row or starting column?

FYI, the last one would require you to hardcode the column and row numbers. I put in completely made up numbers that will not work.

 

[sanantonio]

double post

 

[sanantonio]

No problem. Where does your data start? What row and what column? Is it always consistent or can it change either starting row or starting column?

FYI, the last one would require you to hardcode the column and row numbers. I put in completely made up numbers that will not work.

There's a fix start, D5, but no fixed end. - I just need a few columns and rows either side for asthetics and some hidden information to drive some conditional formatting. I can't put these after the data because I need the macro 2 be flexible to work with infinite items and infinite store/suppliers. But just need it 2 start in D5.

Yeah I tried tinkering with the numbers in the final one but always seem to get the same debug result.

 

[NateSC]

Did you change the following 2 lines to have a "4"? These would replace the original lines where it had a 1.

myLastRow = ws.Cells(Rows.Count, 4).End(xlUp).Row
myFirstRow = ws.Cells(myLastRow, 4).End(xlUp).Row

Here is the whole thing again just in case:

Sub testing2()

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

    'Select MDE Module
    Window1 = "[MDE000] - MDE Module - DB: USWH00" & Sheets("Cover").Range("J13").Value & "L (USWH00" & Sheets("Cover").Range("J13").Value & "L)  Schema: WAWIADM Role: R_WAWI"
    Window2 = "[MDE007] Manual Picklist"
    hWnd = FindWindow(vbNullString, Window1)
    SetForegroundWindow hWnd
    If hWnd > 0 Then
        Else
            MsgBox ("MDE 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
    
    'Figure out how many stores to loop across
    If myLastCol Mod 2 = 0 Then
        numStores = myLastCol / 2
    Else
        temp(1) = MsgBox("The number of columns with store data was not an even number. " _
        & "Please review the data and re-run the macro.", vbOKOnly, "Error in the Data Table")
        Exit Sub
    End If
    
    'Loop 1, enters store, order area, date, and supplier
    For i = 1 To numStores
        
        'Store
        SendKeys ws.Cells(4, i * 2).Value
        SendKeys ("{TAB}")
        'Order Area
        SendKeys ws.Cells(6, i * 2).Value
        SendKeys ("{TAB}")
        'Date
        SendKeys ws.Cells(7, i * 2).Value
        SendKeys ("{TAB}")
        'Supplier
        SendKeys ws.Cells(5, i * 2).Value
        SendKeys ("{TAB}")
        
        'Loop 2, Then loops through items and quanities
        For j = 1 To (myLastRow - myFirstRow - 4)
            myCurrentRow = myFirstRow + 4 + j
            
            SendKeys ws.Cells(myCurrentRow, i * 2 - 1).Value 'Item code
            SendKeys ("{TAB}")
            SendKeys ("{TAB}")
            SendKeys ws.Cells(myCurrentRow, i * 2).Value 'Item quantity
            SendKeys ("{TAB}")
            SendKeys (" ")
        
        Next j
        
        'Saves once all items are complete END OF LOOP 2
        SendKeys ("{F3}")
    
        '<> Starts next Store/Supplier/OrderArea/Date
    
    Next i

End Sub

 

[NateSC]

If it doesn't work, paste this in as a new sub and tell me what numbers it gives you:

Sub NewTest()

Dim ws As Worksheet
Dim myLastCol As Integer
Dim myFirstCol As Integer
Dim myLastRow As Integer
Dim myFirstRow 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

    MsgBox myFirstRow & " " & myLastRow & " " & myFirstCol & " " & myLastCol

End Sub

 

[sanantonio]

Thank you for your patience!

The first macro simply gives me this error:

Despite the data definitely being in D5...

And that second code returns a pop up with:

 

[NateSC]

Replace the code that calculates the number of stores with what I have below. I didn't have it accounting properly for the start and end columns.

'Figure out how many stores to loop across
    If (myLastCol - myFirstCol + 1) Mod 2 = 0 Then
        numStores = (myLastCol - myFirstCol + 1) / 2
    Else
        temp(1) = MsgBox("The number of columns with store data was not an even number. " _
        & "Please review the data and re-run the macro.", vbOKOnly, "Error in the Data Table")
        Exit Sub
    End If

 

[sanantonio]

Okay, I've given that a go.

With my data firmly in D5, it now just enters blanks into the module, tabbing along, entering nothing, tabbing some more. Until eventually it tries to enter a random number into the date field.

Code I'm using now is:

Sub testing2()

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

    'Select MDE Module
    Window1 = "[MDE000] - MDE Module - DB: USWH00" & Sheets("Cover").Range("J13").Value & "L (USWH00" & Sheets("Cover").Range("J13").Value & "L)  Schema: WAWIADM Role: R_WAWI"
    Window2 = "[MDE007] Manual Picklist"
    hWnd = FindWindow(vbNullString, Window1)
    SetForegroundWindow hWnd
    If hWnd > 0 Then
        Else
            MsgBox ("MDE 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
    
'Figure out how many stores to loop across
    If (myLastCol - myFirstCol + 1) Mod 2 = 0 Then
        numStores = (myLastCol - myFirstCol + 1) / 2
    Else
        temp(1) = MsgBox("The number of columns with store data was not an even number. " _
        & "Please review the data and re-run the macro.", vbOKOnly, "Error in the Data Table")
        Exit Sub
    End If
    
    'Loop 1, enters store, order area, date, and supplier
    For i = 1 To numStores
        
        'Store
        SendKeys ws.Cells(4, i * 2).Value
        SendKeys ("{TAB}")
        'Order Area
        SendKeys ws.Cells(6, i * 2).Value
        SendKeys ("{TAB}")
        'Date
        SendKeys ws.Cells(7, i * 2).Value
        SendKeys ("{TAB}")
        'Supplier
        SendKeys ws.Cells(5, i * 2).Value
        SendKeys ("{TAB}")
        
        'Loop 2, Then loops through items and quanities
        For j = 1 To (myLastRow - myFirstRow - 4)
            myCurrentRow = myFirstRow + 4 + j
            
            SendKeys ws.Cells(myCurrentRow, i * 2 - 1).Value 'Item code
            SendKeys ("{TAB}")
            SendKeys ("{TAB}")
            SendKeys ws.Cells(myCurrentRow, i * 2).Value 'Item quantity
            SendKeys ("{TAB}")
            SendKeys (" ")
        
        Next j
        
        'Saves once all items are complete END OF LOOP 2
        SendKeys ("{F3}")
    
        '<> Starts next Store/Supplier/OrderArea/Date
    
    Next i

End Sub

I tried changing the numbers in this part from 4/6/7/5 to 1/3/4/2 respectively but this doesn't changing anything.

    'Loop 1, enters store, order area, date, and supplier
    For i = 1 To numStores
        
        'Store
        SendKeys ws.Cells(4, i * 2).Value
        SendKeys ("{TAB}")
        'Order Area
        SendKeys ws.Cells(6, i * 2).Value
        SendKeys ("{TAB}")
        'Date
        SendKeys ws.Cells(7, i * 2).Value
        SendKeys ("{TAB}")
        'Supplier
        SendKeys ws.Cells(5, i * 2).Value
        SendKeys ("{TAB}")