VBA - loop inside a loop

[plost33]

Hi all, I have a workbook with two sheets. One sheet is my data. the other is a template. I am wanting to use VBA to copy my template sheet to a new sheet then populate the named ranges with the data from my data sheet. My data sheet has headers and I have named the ranges on the template identical to the column headings on the data sheet.

I think all the code needs to do is:

1. copy the template sheet to a new sheet.
2. beginning on data sheet A2, copy the value in A2 and paste that value on the newly created "copy" of the template. The code should paste values only into the named range which matches the column heading, A1.
3. after doing that the code should do the exact same thing for each column on Row 2 A:Q....this is the first loop.
4. after completing row 2 the code should go to row 3..then 4...and so on until the last row which has a value in Column A....this would be the second loop..



I dont think this code is too hard, but my VBA is basic and a loop inside a loop will probably throw me off. Hope someone can assist.

 

[plost33]

here is the code i have come up with so far:

Sub CompleteForms()
Dim Vendor As String
Dim CurrentRow As String
Dim CurrentColumn As String
Dim PasteRangeName As String
Dim XXX As String
Dim Edate As String

For Each cell In Sheets("data").Range("A2:R500")
    On Error Resume Next
    
    CurrentRow = Row
    Vendor = Sheets("Data").Range(A & CurrentRow)
   
    Sheets("Template").Copy After:=Sheets(2)
    Sheets("Template (2)").Name = Vendor
    
     For Each cell In Sheets("data").Range("A" & CurrentRow & ":R" & CurrentRow & "")
        On Error Resume Next
        
        
        
        CurrentColumn = Column
        PasteRangeName = Sheets("data").Range(CurrentColumn & "1").Value
        
        .Copy
        Sheets(Vendor).Range(PasteRangeName).PasteSpecial xlValue
        
        Edate = Sheets(Vendor).Range(Edate).Value
        XXX = Format(Edate, "[$-409]ddmmmyyyy;@")
        
        
        
    Next
    
     Folder = "C:\Users\tphythian\Documents\Vendor Evaluations"
     ThisWorkbook.Worksheets(Vendor).Copy
        With ActiveSheet.UsedRange
            .Value = .Value
        End With
        With ActiveWorkbook
            .SaveAs Folder & "\" & Vendor & " - " & XXX & ".xlsx"
            .Close
        End With
         
    
    Sheets(Vendor).Delete
    
Next
    
   
End Sub

I am getting the follwoing error on the second "for" (i have highlighted it in red above):

"for control varialbe already in use"



i hope someone can assist me in completing this code. i think it is really close to working.

 

[plost33]

Here is tyhe code i ahve so far. anyone know why i am erroring ont he line in red??

Sub CompleteForms()
Dim Vendor As String
Dim CurrentRow As String
Dim CurrentColumn As String
Dim PasteRangeName As String
Dim XXX As String
Dim Edate As String
For Each cell In Sheets("data").Range("A2:R500")
    On Error Resume Next
    
    CurrentRow = Row
    Vendor = Sheets("Data").Range(A & CurrentRow)
   
    Sheets("Template").Copy After:=Sheets(2)
    Sheets("Template (2)").Name = Vendor
    
     For Each cell In Sheets("data").Range("A" & CurrentRow & ":R" & CurrentRow & "")
        On Error Resume Next
        
        
        
        CurrentColumn = Column
        PasteRangeName = Sheets("data").Range(CurrentColumn & "1").Value
        
        .Copy
        Sheets(Vendor).Range(PasteRangeName).PasteSpecial xlValue
        
        Edate = Sheets(Vendor).Range(Edate).Value
        XXX = Format(Edate, "[$-409]ddmmmyyyy;@")
        
        
        
    Next
    
     Folder = "C:\Users\tphythian\Documents\Vendor Evaluations"
     ThisWorkbook.Worksheets(Vendor).Copy
        With ActiveSheet.UsedRange
            .Value = .Value
        End With
        With ActiveWorkbook
            .SaveAs Folder & "\" & Vendor & " - " & XXX & ".xlsx"
            .Close
        End With
         
    
    Sheets(Vendor).Delete
    
Next
    
   
End Sub

 

[GTO]

Hi there,

It is because you are using "cell" in the inner loop, whilst it is already in use in the outer loop.

Mark

 

[plost33]

do you knwo what needs to be done to allow for what i am trying to do?

I am trying to go through each cell on row 2, column A thru R. then move to row 3 and do the same thing...continuing all the way down until there is no more data in column A.

what i am doing is taking data and populating a form with it. then recopying the form, "template" and putting the next rows data in it. once populated the code should save it on in the folder i shows in the code. so once the code is done i have a form populated for each row of data.

 

[plost33]

does anyone else know how the code can be structured to work?

 

[plost33]

hereis the code as i ahve editted it thus far. i have tried getting it to just one loop. i think it will work if the loop is created right.

Sub CompleteForms()
Dim Vendor As String
Dim CurrentRow As String
Dim CurrentColumn As String
Dim PasteRangeName As String
Dim XXX As String
Dim Edate As String
    i = Sheets("data").Range("A2").End(xlDown).Row
    
     For Each cell In Sheets("data").Range("A2:R" & i)
        On Error Resume Next
        
        
        CurrentRow = Row
        Vendor = Sheets("Data").Range(A & CurrentRow)
   
        Sheets("Template").Copy After:=Sheets(2)
        Sheets("Template (2)").Name = Vendor
    
        CurrentColumn = Column
        PasteRangeName = Sheets("data").Range(CurrentColumn & "1").Value
        
        .Copy
        Sheets(Vendor).Range(PasteRangeName).PasteSpecial xlValue
        
        Edate = Sheets(Vendor).Range(Edate).Value
        XXX = Format(Edate, "[$-409]ddmmmyyyy;@")
        
        
        
    Next
    
     Folder = "C:\Users\tphythian\Documents\Vendor Evaluations"
     ThisWorkbook.Worksheets(Vendor).Copy
        With ActiveSheet.UsedRange
            .Value = .Value
        End With
        With ActiveWorkbook
            .SaveAs Folder & "\" & Vendor & " - " & XXX & ".xlsx"
            .Close
        End With
         
    
    Sheets(Vendor).Delete
    
   
End Sub

I cannot tell if the lopp is working ebcause i am erroring on ".copy" line. what i am trying to say here is copy the current cells data. hope someone wiolla ssit me on finishing this code.