How to modify VBA code for Add-in?

[Shetty]

I am creating an add-in for excel which creats a new sheet with data
based on the existing sheets(4 sheets) and a temp sheet which is
deleted at the end.

The primary reason is that I dont want user to run the macro at wrong
place which will mess up the whole data sheets. So I need to create
the new workbook called Reportbook.xls and create the report sheet
there with opening the original workbook as read only. My existing
code runs perfectly within the data workbook. I need to know how to
modify the various componants of code and user forms so that it works
in the addin.
My code (Part) is as below. It runs after user input in two forms.
===============
Sub Sell_entry()
Ref2 = UserForm3.TextBox1.Text
Unload Me
Application.ScreenUpdating = False
Call Manual_Calc
'+++++++++ TIMER START
Dim myTime(4) As Double
myTime(1) = timeGetTime()
'+++++++ Check for any existing sheet and then replace with new.
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Worksheets
If ((sh.Name = "TEMP") Or (sh.Name = "Report")) = True Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
Sheets.Add
ActiveSheet.Name = "Report"
'+++++++ IN
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Sht3 As Worksheet
Dim Ref1 As Variant
Set Sht1 = Sheets("In")
Set Sht2 = Sheets("Report")
Worksheets.Add
ActiveSheet.Name = "TEMP"
Set Sht3 = Sheets("TEMP")
Sht2.Cells.Clear
Sht1.Select
Ref1 = 10
Sht1.Cells(1, 1).AutoFilter Ref1, Ref2
Sht1.Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1)
Sht1.AutoFilterMode = False
Sht3.Activate
Range("A:A,E:E,D,J:J,K:K,L:L,M:M,N:N").Select
Selection.Copy
Sheets("Report").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Columns("A:A").Select
Selection.NumberFormat = "dd-mmm-yy"
Range("D19").Select
Application.CutCopyMode = False
Sht3.Delete
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Value = "Type"
Range("H2").Select
Do While IsEmpty(ActiveCell.Offset(0, -1)) = False
ActiveCell.FormulaR1C1 = "Receipt"
ActiveCell.Offset(1, 0).Select
Loop
Set Sht1 = Nothing
Set Sht2 = Nothing
Set Sht3 = Nothing
=============
This code runs for all 5 sheets, filters and copy the data to temp
sheet, calculates the values and puts the same in new sheet and
deletes the temp sheet.

I was playing with it for last 3 days but could not acheive the goal.
I appologise for such a lengthy code but have no alternative.
Any help is very much appeciated.
Regards,
Shetty.

 

[Bob Phillips]

Shetty,

I would suggest that you start by putting the code in another workbook, and
run it from there. You should be able to find most of the problems.

As a starter, remove all select statements and make it more generic. Here is
a quick recut (not tested, so you should check out it still works, there is
probably some lost reference to an activesheet that you should restore by
object variables)

Call Manual_Calc
'+++++++++ TIMER START
myTime(1) = timeGetTime()
'+++++++ Check for any existing sheet and then replace with new.
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Worksheets
If ((sh.Name = "TEMP") Or (sh.Name = "Report")) Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
Worksheets.Add.Name = "Report"
'+++++++ IN
Set Sht1 = Sheets("In")
Set Sht2 = Sheets("Report")
Set Sht3 = Worksheets.Add.Name = "TEMP"
Sht2.Cells.Clear
Sht1.Select
Ref1 = 10
Sht1.Cells(1, 1).AutoFilter Ref1, Ref2
Sht1.Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1)
Sht1.AutoFilterMode = False
Sht3.Activate
Range("A:A,E:E,D,J:J,K:K,L:L,M:M,N:N").Copy
Sheets("Report").Select
Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Columns("A:A").NumberFormat = "dd-mmm-yy"
Application.CutCopyMode = False
Sht3.Delete
Columns("H:H").Insert Shift:=xlToRight
Range("H1").Value = "Type"
With Range("H2")
Do While IsEmpty(.Offset(i, -1)) = False
.Offset(i, 0).FormulaR1C1 = "Receipt"
i = i + 1
Loop
End With
Set Sht1 = Nothing
Set Sht2 = Nothing
Set Sht3 = Nothing
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)