vba/macro need help

kayak

New member
Joined
Aug 6, 2012
Messages
3
Reaction score
0
Points
0
Hello,

I have updated a project that i have from Excel 2003 to 2010. Only problem is that i can not get it running in Excel 2010.

When i fill in all the details i then create an invoice but this is where i am getting nowhere. I think there is a problem with the code.

Can anyone show me where i have gone wrong.

Thanks
 

Attachments

  • quote temp Master.xlsm
    38.9 KB · Views: 29
What's the output file for?

This code is a big improvement on a small piece of yours

Code:
' Create Invoice sheet; delete older sheets if they existApplication.DisplayAlerts = False
If (Worksheets.Count > 1) Then
    tempstr = MsgBox("Other sheets already exist. Do you wish to overwrite: Y/N", vbYesNo)
    If UCase(Left(tempstr, 1)) = "Y" Then
        For i = Worksheets.Count To 1 Step -1
            If (Sheets(i).Name <> "Quote") Then
                Sheets(i).Delete
            End If
        Next i
    Else
        Exit Sub
    End If
End If
Application.DisplayAlerts = True
 
Hello Bob,

The output file is for my accounting program.

I have copied the code and placed it into the creatinvoice macro. When i save the file and close it i get a compile error "invalid outside procedure and line 2 of your code worksheets. is highlighted in blue. Have i done something wrong.

Kind regards

Keith
 
When i step through the code listed below i see where you are deleting all sheets except Quote. When that happens it all blows up . I did not see anywhere further down in the code where you are recreating the Names and RateMaster sheets, so i am led to beleive this is not what needs to be happening.

When i changed the code to delete just the existing Invoice sheet the code works fine . it created the new sheet , renamed it Invoice, and filled and formatted the new Invoice sheet perfectly.

There is still one other code problem that needs to be corrected. the code that numbers your invoices has issues. will need to investigate further. Maybe Bob can spot something there that i am not seeing at first glance.

Code:
If (Worksheets.Count > 1) Then
    tempstr = InputBox("Other sheets already exist. Do you wish to overwrite: Y/N", vbYesNo)
    If UCase(Left(tempstr, 1)) = "Y" Then
        For i = Worksheets.Count To 1 Step -1
            If (Sheets(i).Name <> "Quote") Then
                Sheets(i).Delete
            End If
        Next i
 
This runs the create macro without errors. This was Ran in Excel 2007 .


Code:
Sub CreateInvoice()
Dim InvoiceNumber As Long, ipos As Long, tempstr As String, TempStr2 As String
Dim SID As String, Desc As String, Sbt, VAT, CurDat
' Create Invoice sheet; delete older sheets if they exist
If (Worksheets.Count > 1) Then
    tempstr = InputBox("Other sheets already exist. Do you wish to overwrite: Y/N", vbYesNo)
    If UCase(Left(tempstr, 1)) = "Y" Then
        
        Worksheets("Invoice").Delete
        
              
    Else
        Exit Sub
    End If
End If
    
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Sheets(4).Name = "Invoice"
With Worksheets("Invoice")
    ' get current invoice number
    tempstr = "C:\keith\test-bell" ' ***ALTER THIS PATHNAME
    
    
    If Dir(tempstr) = "" Then
        InvoiceNumber = 999 ' ***SET THIS TO YOUR NEXT INVOICE# - 1, JUST THE 1ST TIME
    Else
        Open tempstr For Input As #1
        On Error GoTo AbEnd1
        While Not EOF(1)
            Line Input #1, TempStr2
            InvoiceNumber = Val(TempStr2)
        Wend
AbEnd1:
    Close #1
    End If
    
    ' Increment the invoice file
    InvoiceNumber = InvoiceNumber + 1
   
    
    Open tempstr For Output As #1
        Print #1, InvoiceNumber
    Close #1
    
    ' Fill out the Invoice sheet
    .Cells(12, 10) = UCase(Sheets(1).Cells(1, 2))
    .Cells(14, 7) = InvoiceNumber
    .Cells(14, 10) = Date
    .Cells(21, 1) = Date
    .Cells(7, 1) = Sheets(1).Cells(33, 1)
    .Cells(8, 1) = Sheets(1).Cells(33, 2)
    .Cells(9, 1) = Sheets(1).Cells(33, 4)
    .Cells(10, 1) = Sheets(1).Cells(33, 6)
    .Cells(11, 1) = Sheets(1).Cells(33, 8)
    .Cells(21, 3) = Sheets(1).Cells(1, 4)
    .Cells(21, 10) = Sheets(1).Cells(26, 3) - Sheets(1).Cells(21, 7)
    .Cells(38, 6) = "CARRIAGE AND PACKING"
    .Cells(38, 10) = Sheets(1).Cells(21, 7)
    .Cells(40, 7) = "SUB TOTAL £"
    .Range("J40").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-19]C:R[-2]C)"
    .Cells(41, 7) = "VAT @ 20 % £"
    .Range("J41").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C*0.20"
    .Cells(44, 7) = "TOTAL £"
    .Range("J44").Select
    ActiveCell.FormulaR1C1 = "=R[-4]C+R[-3]C"
    
    ' format the invoice sheet
    Worksheets("Invoice").Select
    .Columns("A:J").Select
    Selection.Font.Bold = True
    .Range("C17").Select
    Selection.NumberFormat = """Invoice Number: ""@"
    .Range("J21:J44").Select
    Selection.NumberFormat = """£""#,##0.00;[Red]-""£""#,##0.00"
    .Range("J44").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    .Range("D17").Select
    Selection.NumberFormat = "mmmm d, yyyy"
    .Columns("J:J").Select
    With Selection
        .HorizontalAlignment = xlRight
    End With
    .Range("A1").Select
    
    ' do page setup here
    Application.ScreenUpdating = False
    ActiveSheet.PageSetup.PrintArea = "$A$1:$J$44"
    With ActiveSheet.PageSetup
        .LeftMargin = 60 ' ADJUST TO METRIC UNITS IF NEEDED
        .RightMargin = 0 ' ADJUST TO METRIC UNITS IF NEEDED
        .TopMargin = 80 ' ADJUST TO METRIC UNITS IF NEEDED70
        .BottomMargin = 27 ' ADJUST TO METRIC UNITS IF NEEDED
        .HeaderMargin = 17 ' ADJUST TO METRIC UNITS IF NEEDED
        .FooterMargin = 27 ' ADJUST TO METRIC UNITS IF NEEDED
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    Application.ScreenUpdating = True
End With
End Sub
 
Hello tommyt61 and Bob Phillips,

I have had to resort to go back to the 2003 version as office 2010 has profile issues with this workbook. (something to do with the macros)
Many thanks for your help.

Kind regards
Keith
 
If this helps any ... I ran the create macro in a version of Excel 2010 and it ran just fine. It is not the macro code itself. Apparently there is an issue with files in your 2010 environment. I don't know what errors you are getting but I would do a little research on Visual Basic 6.0 Runtime Extended Files. Can't say for sure this is where the problems lies , but it would not hurt to rule it out. Good Luck !
 
Back
Top