Command Button to prompt after opening workbook

[suresh ullanki]

Hi,

The following code is run upon opening the workbook. is it possible to Prompt command button rather than running macro automatically. I tried my best. but could not success. command button should prompt to run macro.

Sub Auto_open()
MsgBox "Please select Source File"
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
Workbooks.Open Filename:=NewFN
End If

Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim i As Long
Set ws2 = ThisWorkbook.Sheets("Format")
Set wkb = ActiveWorkbook
Set ws1 = wkb.Sheets("Headcount Reg")

Application.ScreenUpdating = False
lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To ws1.UsedRange.Columns.Count 'This can be changed to 70 if there are columns after BQ that are not copied.
Select Case i
Case Is <= 6
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i)
Case 8 To 14
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i - 1)
Case 15 To 16
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 3)
Case 17 To 38
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)
Case 39 To 45
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 7)
Case 46 To 47
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 23)
Case 48 To 58
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)

End Select
Next i
ws2.SaveAs Filename:="csvformat", FileFormat:=xlCSV, CreateBackup:=True

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Try this:

Sub Auto_open()
[COLOR=#ff0000]Dim ans As String
ans = MsgBox("Continue with script", vbYesNo + vbQuestion, "Question")
If ans = vbYes Then[/COLOR]
MsgBox "Please select Source File"
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
Workbooks.Open Filename:=NewFN
End If
Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim i As Long
Set ws2 = ThisWorkbook.Sheets("Format")
Set wkb = ActiveWorkbook
Set ws1 = wkb.Sheets("Headcount Reg")
Application.ScreenUpdating = False
lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ws1.UsedRange.Columns.Count 'This can be changed to 70 if there are columns after BQ that are not copied.
Select Case i
Case Is <= 6
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i)
Case 8 To 14
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i - 1)
Case 15 To 16
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 3)
Case 17 To 38
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)
Case 39 To 45
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 7)
Case 46 To 47
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 23)
Case 48 To 58
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)
End Select
Next i
ws2.SaveAs Filename:="csvformat", FileFormat:=xlCSV, CreateBackup:=True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Else
Exit Sub
End Sub