Need VBA code to create loops Please [Solved/Closed]

Report
-
 FaizanRoshan88 -
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


3 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
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
Hi Thanks for responding. I am getting a "type mismatch" error now. I am kind of doing a loop within a loop. (nested?) Anyway, I want it to repeat what the code is doing now but the column "N" and "O" contain the code number and the row number the cells are to be copied to. So the values will change and the amount of rows will change. I was getting "type mismatch" too. What could be causing that?
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
Could you please upload a sample file with sample data etc on some shared site like https://authentification.site and post back here the link to allow better understanding of how it is now and how you foresee.

One error was this. I have now corrected it

lastORow = Worksheets("Itemized Costs2").Cells(Rows.Count, "O").End(xlUp).Row
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!

Hi, i have found same problem.
I have a vba code that have too long, i can't be able to make it short because i have not experience in vba. but i believe its will be done some one that have experience. Here is code:

Sub Macro1()
'
' Macro1 Macro
'
Range("A5").Value = "4-16 - 4-22"
Range("B5").Value = "1st"
Range("C5").FormulaR1C1 = "=AVERAGEIFS('adt4-16 - 4-22'!C16, 'adt4-16 - 4-22'!C16, "">301"",'adt4-16 - 4-22'!C16, ""<480"")"
Range("D5").FormulaR1C1 = "=COUNTIFS('adt4-16 - 4-22'!C16,"">""&301,'adt4-16 - 4-22'!C16,""<""&480)"
Range("E5").FormulaR1C1 = "=(R2C3-RC3)*(R1C4*RC4)"
Range("F5").FormulaR1C1 = "=AVERAGEIFS('adt4-16 - 4-22'!C16, 'adt4-16 - 4-22'!C16, "">=1"",'adt4-16 - 4-22'!C16, ""<300"")"
Range("G5").FormulaR1C1 = "=COUNTIFS('adt4-16 - 4-22'!C16,"">=""&1,'adt4-16 - 4-22'!C16,""<""&300)"
Range("H5").FormulaR1C1 = "=(R2C3-RC6)*(R1C4*RC7)"
Range("I5").FormulaR1C1 = "=AVERAGE('adt4-16 - 4-22'!C16)"
Range("J5").FormulaR1C1 = "=COUNTIFS('adt4-16 - 4-22'!C16,"">=""&1)"
Range("K5").FormulaR1C1 = "=(R2C3-RC9)*(R1C4*RC10)"


Range("A6").Value = "4-23 - 4-29"
Range("B6").Value = "2nd"
Range("C6").FormulaR1C1 = "=AVERAGEIFS('adt4-23 - 4-29'!C16, 'adt4-23 - 4-29'!C16, "">301"",'adt4-23 - 4-29'!C16, ""<480"")"
Range("D6").FormulaR1C1 = "=COUNTIFS('adt4-23 - 4-29'!C16,"">""&301,'adt4-23 - 4-29'!C16,""<""&480)"
Range("E6").FormulaR1C1 = "=(R[-4]C3-RC3)*(R1C4*RC4)"
Range("F6").FormulaR1C1 = "=AVERAGEIFS('adt4-23 - 4-29'!C16, 'adt4-23 - 4-29'!C16, "">=1"",'adt4-23 - 4-29'!C16, ""<300"")"
Range("G6").FormulaR1C1 = "=COUNTIFS('adt4-23 - 4-29'!C16,"">=""&1,'adt4-23 - 4-29'!C16,""<""&300)"
Range("H6").FormulaR1C1 = "=(R[-4]C3-RC6)*(R1C4*RC7)"
Range("I6").FormulaR1C1 = "=AVERAGE('adt4-23 - 4-29'!C16)"
Range("J6").FormulaR1C1 = "=COUNTIFS('adt4-23 - 4-29'!C16,"">=""&1)"
Range("K6").FormulaR1C1 = "=(R2C3-RC9)*(R1C4*RC10)"


End Sub

This code is only for 2 row & 2 sheet, i have hundred of rows and sheets for calculation.

thanks