Need VBA code to create loops Please Solved/Closed

Question

I have done loops before but it has been a long time.  I need to loop through rows of data and the rows of data changes.  The value in column "N" is the code number and Column "O" is the row number where "N" belongs.
I have not put in code for looping so this is the code without loop.  It looks up data in the source sheet and copys it to the destination sheet based on the code row number.

Sub WOLoopTest()
  Dim DestSheet        As Worksheet
  Dim NewRow As Integer

  Set DestSheet = Worksheets("Itemized Costs3")
  NewRow = Worksheets("Itemized Costs2").Range("O2").Value 'Destination ROW NUMBER

  
  Dim sRow       As Long     'row index on source worksheet
  Dim dRow       As Long     'row index on destination worksheet
  Dim sCount     As Long
  Dim SumL As Variant
  SumL = 0
  
  sCount = 0
  Sheets("Itemized Costs3").Select

Dim strsearch As String
strsearch = CStr(Worksheets("Itemized Costs2").Range("N2").Value) 'code num to search for in data sheet

  For sRow = 1 To Range("V65536").End(xlUp).Row  'search for code
     If Cells(sRow, "V") Like strsearch Then
        sCount = sCount + 1
        dRow = NewRow + 1
        NewRow = NewRow + 1  'destination row +1
       
        DestSheet.Cells(dRow, "B") = Cells(sRow, "B")
        DestSheet.Cells(dRow, "C") = Cells(sRow, "C")
        DestSheet.Cells(dRow, "D") = Cells(sRow, "D")
        DestSheet.Cells(dRow, "E") = Cells(sRow, "E")
        DestSheet.Cells(dRow, "F") = Cells(sRow, "F")
        DestSheet.Cells(dRow, "G") = Cells(sRow, "G")
        DestSheet.Cells(dRow, "H") = Cells(sRow, "H")
        DestSheet.Cells(dRow, "I") = Cells(sRow, "I")
        DestSheet.Cells(dRow, "J") = Cells(sRow, "J")
        DestSheet.Cells(dRow, "K") = Cells(sRow, "K")
        DestSheet.Cells(dRow, "L") = Cells(sRow, "L")

        SumL = SumL + Cells(sRow, "L")

     End If
  Next sRow
   
  MsgBox "Total = " & Format(SumL, Format:="$0,0.00") & Chr(10) & Chr(10) & sCount & " Row(s) have been copied", vbInformation, "Transfer Done"
 '  ActiveCell.Offset(1, 0).Select
  '    Loop
    ' Application.Run "Sheet15.WOLoopTest2"
  
End Sub


Configuration: Windows XP / Internet Explorer 8.0

rizvisa1 · Answer

Not entirely sure what you were looking for as I see that your code already had a loop. This is based on what i thought you meant  

Sub WOLoopTest()  
Dim DestSheet As Worksheet  
Dim NewRow As Integer  
Dim sRow As Long 'row index on source worksheet  
Dim dRow As Long 'row index on destination worksheet  
Dim sCount As Long  
Dim SumL As Variant  
Dim strsearch As String  
Dim lastORow As Long  
Dim myORow As Long  

    lastORow = Worksheets("Itemized Costs2").Cells(Rows.Count, "O").end(xlup).Row  
      
    Set DestSheet = Worksheets("Itemized Costs3")  
      
    SumL = 0  
    sCount = 0  
      
    For myORow = 2 To lastORow  
      
        NewRow = Worksheets("Itemized Costs2").Range("O" & myORow).Value 'Destination ROW NUMBER  
          
        Sheets("Itemized Costs3").Select  
          
        strsearch = CStr(Worksheets("Itemized Costs2").Range("N" & myORow).Value) 'code num to search for in data sheet  
          
        For sRow = 1 To Range("V65536").End(xlUp).Row 'search for code  
          
            If Cells(sRow, "V") Like strsearch Then  
              
                sCount = sCount + 1  
                dRow = NewRow + 1  
                NewRow = NewRow + 1 'destination row +1  
                  
                DestSheet.Cells(dRow, "B") = Cells(sRow, "B")  
                DestSheet.Cells(dRow, "C") = Cells(sRow, "C")  
                DestSheet.Cells(dRow, "D") = Cells(sRow, "D")  
                DestSheet.Cells(dRow, "E") = Cells(sRow, "E")  
                DestSheet.Cells(dRow, "F") = Cells(sRow, "F")  
                DestSheet.Cells(dRow, "G") = Cells(sRow, "G")  
                DestSheet.Cells(dRow, "H") = Cells(sRow, "H")  
                DestSheet.Cells(dRow, "I") = Cells(sRow, "I")  
                DestSheet.Cells(dRow, "J") = Cells(sRow, "J")  
                DestSheet.Cells(dRow, "K") = Cells(sRow, "K")  
                DestSheet.Cells(dRow, "L") = Cells(sRow, "L")  
                  
                SumL = SumL + Cells(sRow, "L")  
              
            End If  
        Next sRow  
          
    Next myORow  
      
    MsgBox "Total = " & Format(SumL, Format:="$0,0.00") & Chr(10) & Chr(10) & sCount & " Row(s) have been copied", vbInformation, "Transfer Done"  
    ' ActiveCell.Offset(1, 0).Select  
    ' Loop  
    ' Application.Run "Sheet15.WOLoopTest2"  

End Sub

Jan · Answer

Here is the link:
https://authentification.site/files/22241168/ABC_Company_Looping_test_with_run_macro_button.xls

Jan · Answer

I see where the "type mismatch" is coming from.  I had formulas in the column "O" that had no value.  It works now.  I just need to find a "work around" for the formula issue.  I think that will be an easy fix though.  Thanks so much for your help.  You were great!

Need VBA code to create loops Please

3 responses

Similar discussions

Subscribe To Our Newsletter!