Macros works on Personal.XLSB, but when transfer to VBA this debugs.

[kitsa]

Hi Guys,
I have created a Macro in my personal macro, but when I transfer to VBA it doesn't work and debugs, can someone please explain why this is happening. It stops when it gets to the bold "Cells.Select"

Private Sub CommandButton2_Click()
Application.DisplayAlerts = False
   Dim dmy As String
   dmy = Format((Now), "yyyy")
    ChDir _
        "F:\GuyM\TinaA\My Documents\ESS PROGRESS CLAIMS"
    ActiveWorkbook.SaveAs Filename:= _
         "C:\Users\kitsas\Desktop\ESS Contract Administration Reconciliation\Baranagaroo\" & "Barangaroo " & " " & MonthName(Month(Now)) & " " & dmy & ".xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P19").Select
    Application.CutCopyMode = False
    Columns("L:P").Select
    Selection.ClearContents
    Columns("A:A").Select
    Selection.ClearContents
    Range("L17").Select
    Sheets("Invoice").Select
    Cells.Select
    Range("B1").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B14").Select
    Range("H13:H17").Select
    Range("D13:D17").Select
    Sheets("ESS Inv Data Entry").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("Summary").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Description").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Control Sheet").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Estimate").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Claim Summary").Select
    Range("M22").Select
    ActiveWindow.SmallScroll Down:=-21
    ActiveSheet.Shapes.Range(Array("Signed Contract")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Payment Schedule")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Send Email")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Print Document")).Select
    Selection.Delete
    Range("M13").Select
    Columns("I:M").Select
    Selection.ClearContents
    Range("L2").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\kitsas\Desktop\ESS Contract Administration Reconciliation\Baranagaroo\Barangaroo Invoice.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Range("L30").Select
    Sheets("Claim Summary").Select
    ActiveWindow.SmallScroll Down:=-12
    ActiveWorkbook.Save
    Range("M10").Select
'---------------------------------------
'Send Email
  
 Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = "Hi Greg," & _
              "
" & "As attached, is your invoice for review, please confirm via email or payment schedule once evaluated for reconciliation purpose." & _
              "
" & _
              "
" & _
              "
" & "If you have any issues please do not hesitate to contact me." & _
              "
"
    On Error Resume Next
    With OutMail
        .display
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Service"
        .HTMLBody = strbody & "" & .HTMLBody
               
        .Importance = 2 'Or olImprotanceHigh Or olImprotanceLow
        .display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set OutLookMess = Nothing
    Set OutLookNSpace = Nothing
ActiveWorkbook.Close
End Sub

 

[Michael M]

Re: Macrs works on Personal.XLSB, but when transfer to VBA this debugs.

Don't have Excel at the moment, but try the modified code....ON A TEST WORKBOOK !!!

Private Sub CommandButton2_Click()
Application.DisplayAlerts = False
   Dim dmy As String
   dmy = Format((Now), "yyyy")
    ChDir _
        "F:\GuyM\TinaA\My Documents\ESS PROGRESS CLAIMS"
    ActiveWorkbook.SaveAs Filename:= _
         "C:\Users\kitsas\Desktop\ESS Contract Administration Reconciliation\Baranagaroo\" & "Barangaroo " & " " & MonthName(Month(Now)) & " " & dmy & ".xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    With ActiveSheet.UsedRange
    .Value = .Value
    End With
    Columns("A:A,L:P").ClearContents
    With Sheets("Invoice").Range("B1")
    .Value = .Value
    End With
    Sheets(Array("ESS Inv Data Entry", "Summary", "Description", "Control Sheet", "Estimate")).Delete
    Sheets("Claim Summary").Range("M22").Select
    With ActiveSheet
    .Shapes.Range(Array("Signed Contract")).Delete
    .Shapes.Range(Array("Payment Schedule")).Delete
    .Shapes.Range(Array("Send Email")).Delete
    .Shapes.Range(Array("Print Document")).Delete
    End With
    Columns("I:M").ClearContents
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\kitsas\Desktop\ESS Contract Administration Reconciliation\Baranagaroo\Barangaroo Invoice.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
'---------------------------------------
'Send Email
  
 Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = "Hi Greg," & _
              "" & _
"As attached, is your invoice for review, please confirm via email or payment schedule once evaluated for reconciliation purpose." & _
              "" & _
              "" & _
              "" & "If you have any issues please do not hesitate to contact me." & _
              ""
    On Error Resume Next
    With OutMail
        .display
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Service"
        .HTMLBody = strbody & "" & .HTMLBody
               
        .Importance = 2 'Or olImprotanceHigh Or olImprotanceLow
        .display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set OutLookMess = Nothing
    Set OutLookNSpace = Nothing
ActiveWorkbook.Close
End Sub

 

[kitsa]

Re: Macrs works on Personal.XLSB, but when transfer to VBA this debugs.

Thanks Michael,
It comes up with an error when it hits "Columns("A:A,L:P").ClearContents". Somehow it's stopping from it going further.

Thanks
Kitsa

 

[Michael M]

Re: Macrs works on Personal.XLSB, but when transfer to VBA this debugs.

Sorry...
change it to

[color=red]Range[/color]("A:A,L:P").ClearContents

 

[kitsa]

Re: Macrs works on Personal.XLSB, but when transfer to VBA this debugs.

Hello Michael,

Thanks it worked, but the ".Value = .Value" changes to value of "Currency" format, how do I make the format to be "Accounting"?

 

[Michael M]

Re: Macrs works on Personal.XLSB, but when transfer to VBA this debugs.

Reformat the cells...the code does not change the format of the cells as it is now !!
Add this line after the value = .value line

.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"