code stopping

[plost33]

i have the following coe that works great. problem is it is stopping after only 77 rows instead of after 334. i=334 when the code runs, so i dont knwo why it is stopping. all i can think of is that it have something to do witht he fact that the folder i am putting ther files in get too full or something?? anyone see any probelms?

Sub CompleteForms()
Dim Vendor As String
Dim Vendor1 As String
Dim CurrentRow As String
Dim CurrentColumn As Long
Dim PasteRangeName As String
Dim XXX As String
Dim Edate As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    i = Sheets("data").Range("A2").End(xlDown).Row
    
     For Each cell In Sheets("data").Range("A2:R" & i)
        On Error Resume Next
        
        CurrentRow = cell.Row
        CurrentColumn = cell.Column
        
        If CurrentColumn = 1 Then
        
            Sheets("Template").Visible = True
            Sheets("Template").Copy After:=Sheets(2)
            Vendor1 = Sheets("Data").Range("B" & CurrentRow)
            Vendor = Left(Vendor1, 12)
            Sheets("Template (2)").Name = Vendor
                        
        Else
        End If
        
        
        PasteRangeName = Sheets("data").Cells(1, CurrentColumn).Value
        
        cell.Copy
        Sheets(Vendor).Range(PasteRangeName).PasteSpecial xlValue
        
        
        If CurrentColumn = 18 Then ' 18 is column R
        
            Edate = Sheets(Vendor).Range(Edate).Value
            XXX = Format(Edate, "[$-409]ddmmmyyyy;@")
            
            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
                
       Else
       End If
       
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Worksheets("Template").Visible = False
    
    MsgBox "All Vendor Evaluations have been created and saved in the Vendor Evaluations folder!"
       
End Sub

 

[AlphaFrog]

Do you have any blank cells in between your data in column A?

This will set i to the row just above the 1st blank cell below A2 and not the last used row.

i = Sheets("data").Range("A2").End(xlDown).Row

This will set i to the last used row in column A

i = Sheets("data").Range("A" & Rows.Count).End(xlUp).Row

 

[ChrisM]

It's pretty dangerous to use a "On Error Resume Next" over such a large and varied bit of code. Lots of different functions in there, couple different places where errors could arise. Are you sure that a Resume Next will allow ALL of those situations to gracefully resolve?

I would run the code without the on error statement and see if it errors out.

Couple tips:

You can simplify your code by turning this:
Vendor1 = Sheets("Data").Range("B" & CurrentRow)
Vendor = Left(Vendor1, 12)

into this:
Vendor = Left(Sheets("Data").Range("B" & CurrentRow),12)

Do you ever have any situations where you would attempt to save a duplicate file name? Is that why you added the On Error? If so, change your date formula to include the seconds, and use that in the file name, that should give you a sufficiently unique name. Though technically, to be correct, you really should test if a file name exists first before saving.

 

[plost33]

I am now getting the following error on the line in red:

application-defined or object-defined error

Sub CompleteForms()
Dim Vendor As String
Dim Vendor1 As String
Dim CurrentRow As String
Dim CurrentColumn As Long
Dim PasteRangeName As String
Dim XXX As String
Dim Edate As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    i = Sheets("data").Range("A2").End(xlDown).Row
    
     For Each cell In Sheets("data").Range("A2:R" & i)
       'On Error Resume Next
        
        CurrentRow = cell.Row
        CurrentColumn = cell.Column
        
        If CurrentColumn = 1 Then
        
            Sheets("Template").Visible = True
            Sheets("Template").Copy After:=Sheets(2)
            Vendor1 = Sheets("Data").Range("B" & CurrentRow)
            Vendor = Left(Vendor1, 12)
            Sheets("Template (2)").Name = Vendor
                        
        Else
        End If
        
        
        PasteRangeName = Sheets("data").Cells(1, CurrentColumn).Value
        
        cell.Copy
        Sheets(Vendor).Range(PasteRangeName).PasteSpecial xlValue
        
        
        If CurrentColumn = 18 Then ' 18 is column R
        
            Edate = Sheets(Vendor).Range(DateofEvaluation).Value
            XXX = Format(Edate, "[$-409]ddmmmyyyy;@")
            
            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
                
       Else
       End If
       
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Worksheets("Template").Visible = False
    
    MsgBox "All Vendor Evaluations have been created and saved in the Vendor Evaluations folder!"
       
End Sub

why si this happening?

 

[plost33]

chris, great ideas. thanks.

i have change the vendor1 thing to:

Vendor = Left(Sheets("Data").Range("B" & CurrentRow),12)




as you suggested. I have also now figuered out what was causing my code to have issues and stop. it was/is happening because my vendor name on that one where it mess' up have a "/" in the name. is there anyway to have the above formula you provided show the 12 characters formt he left or up to the "/" if the vendor name has one in it?

 

[plost33]

anyone ave any ideas on how to rewrite this formula so that it stops at 12 characters or a "/"...which ever comes first??

Vendor = Left(Sheets("Data").Range("B" & CurrentRow),12)

 

[AlphaFrog]

Vendor = Left(Sheets("Data").Range("B" & CurrentRow), 12)
If InStr(Vendor, "/") Then Vendor = Left(Vendor, InStr(Vendor, "/"))

 

[plost33]

thanks! do you see why i am getting an error on this line:

Edate = Sheets(Vendor).Range(DateofEvaluation).Value


the error says: application-defined or object-defined error

 

[AlphaFrog]

Vendor will include the "/". Do you want that? If not, then try this...

Vendor = Left(Sheets("Data").Range("B" & CurrentRow), 12)
If InStr(Vendor, "/") Then Vendor = Left(Vendor, InStr(Vendor, "/") [COLOR="Red"]- 1[/COLOR])

 

[plost33]

yeah i do not want to include the "/". any idea why my "EDate" is erroring out?