Help with For Loop - works great except for the last bit

[Oberon70]

Hi,

I have a loop that moves the data into different format, so I can paste it into a system.

The loop is working great until the end.

section 1 of the loop has 16 items on one page.
Section 2 has 2 lots of 6 and last page 4.

So lets say I have 155 transactions that equates to set of 9 complete sets of 16 and the last set being 11
The same if I have 70 transactions that equates to to 4 complete sets of 16 and the last set being 6.

The 1st part of my code I was able to get the loop to recognise that the last section needs to be the remaining number from the transaction. Basically, I subtracted 16 from the transaction until the count was created than the transaction then I over rode the final loop on section one to equal the number of transactions left, but I can't seem to figure how to do this on the 2nd part.

I really hope someone can help me on this. so lets say the below was 27 transactions, 1st section of the code reduce the last section to 11, but the 2nd part still is completing the all three loops, were it need to only do two loops and one less entry. sorry, hope this make since.

Sub CrtWorkFlw()

Dim lastrow As Double
Dim AgtName As String
Dim InvNum As String
Dim TransCnt As Double 'The total count of transactions being looped.
Dim Mloop As Double 'The start of the main loop through the transactions
Dim Tloop As Double 'The start of the loop for recovered funds
Dim rNum As Double 'this is for the row Location for data to be entered on the spreadsheet cells(rNum, cNum)
Dim cNum As Double 'this is for the column Location for data to be entered on the spreadsheet cells(rNum, cNum)
Dim clcnt2 As Double 'variable to assist with the location of the data being sorted.
Dim clcnt As Double
Dim nLoop As Double 'How many loops through the code that the main loop will do.
Dim TloopCnt As Double  'what the recvovred funds are counting down too.
Dim cc As Double 'variable used to asssit with keeping track if there is less than 16 entries left to loop through.
Dim dd As Double



Dim CommLoop As Double
Dim CommLoop2 As Double
Dim CommLoop3 As Double


Dim CommLoopCnt As Double
Dim CommLoopCnt2 As Double


lastrow = wsSupSheet.Cells(Rows.Count, "A").End(xlUp).Row

AgtName = Trim(wsInvDtls.Range("B3").Value)
InvNum = wsInvDtls.Range("B1").Value

Select Case AgtName
    Case "RecoveriesCorp"
        AgtName = "RecovCrp"
    Case "National Mercantile"
        AgtName = "National Merc"
End Select

wsSupSheet.Range("A" & lastrow & ":" & "C" & lastrow).Offset(1).Merge
wsSupSheet.Range("A" & lastrow & ":" & "C" & lastrow).Offset(1) = (AgtName & " " & InvNum)

TransCnt = wsTmpSh.Cells(Rows.Count, "A").End(xlUp).Row - 1 'Taken one off for the header.

rNum = 3
cNum = 2
clcnt = 1
clcnt2 = 1
nLoop = TransCnt / 16
TloopCnt = 16
cc = TransCnt
dd = TransCnt + 16
CommLoopCnt = 3
CommLoopCnt2 = 6

'''''''''''''''''''''''Main Loop'''''''''''''''''''''''

For Mloop = 1 To nLoop + 1
    
'''''''''''''''''''''''T Screen Loop'''''''''''''''''''

        For Tloop = 1 To TloopCnt
            wsSupSheet.Range("A" & lastrow).Offset(rNum, cNum) = "K" & wsTmpSh.Range("A" & clcnt + 1)
            wsSupSheet.Range("A" & lastrow).Offset(rNum, cNum + 1) = wsTmpSh.Range("B" & clcnt + 1)
            rNum = rNum + 1
         
            clcnt = clcnt + 1
        Next Tloop
        cc = cc - 16
        
        If TloopCnt > cc Then
            TloopCnt = cc
            
        End If
        
'''''''''''''''''''''''Commision Loop'''''''''''''''''''
        dd = cc
        rNum = rNum + 1
        'dd = dd - 16
        Debug.Print cc
        
        
        CommLoopCnt2 = 6
        
        
        For CommLoop = 1 To CommLoopCnt
            For CommLoop2 = 1 To CommLoopCnt2
                wsSupSheet.Range("A" & lastrow).Offset(rNum, cNum) = "N" & wsTmpSh.Range("A" & clcnt2 + 1)
                clcnt2 = clcnt2 + 1
                cNum = cNum + 1
              
            Next CommLoop2
                  'dd = dd - 2
                If CommLoop = 2 Then
                  CommLoopCnt2 = 4
                End If
                cNum = 2
                rNum = rNum + 1
               ' If cc < 16 Then
                   ' CommLoopCnt2 = CommLoopCnt2 + cc
               ' End If
           
       Next CommLoop
        
        
        rNum = rNum + 1
  
Next Mloop

End Sub

 

[BSALV]

why don't you do in one effort what you want,
the 1st array to another sheet, the 2nd array to ...

 

[Oberon70]

That is a thought, I will look into that, just going to receipt now, finish off two statements tonight. - thank you for your help.

 

[BSALV]

now with a click right event in the sheetmodule of "Blad2".
If you want another event, choose that one.
Everything is now under each other with your yellow cells.
See link.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     
     If Intersect(Target, Columns("AA")) Is Nothing Then Exit Sub 'stop if you ddin't right click in the AA-column

     'later instead of that msgbox, you do target.offset(......).COPY

     Select Case Target.Row Mod 60 'depending on the rownumber (modulus 60 !!), choose a range
          Case 2: MsgBox Target.Offset(, 2).Resize(16, 2).Address
          Case 19 To 21: MsgBox Target.Offset(, 2).Resize(1, 48).Address
          Case 24: MsgBox Target.Offset(, 2).Resize(34, 3).Address
          Case Else: Exit Sub
     End Select

     Cancel = True 'cancel the normal popup for right-clicking
     
End Sub

 

[Oberon70]

Thank you I will try this out shortly