Excel with VBA save good but crash on close Very Urgent Please !!!!!

B

bebo201022

New Member
Joined
Sep 24, 2017
Messages
3
i am new in excel VBA, and after finishing below code, the function of the code is running very well and i can save it but when i try to close it i have not responding error and it crash all excel and restart it, the code has been used is :

Code in workbook :

Private Sub Workbook_Open()
UserForm1.Show
End Sub


Userform1:

Private Sub OptionButton1_Click()
UserForm2.Show
End Sub

Private Sub OptionButton2_Click()
UserForm2.Show
End Sub

Private Sub OptionButton3_Click()
UserForm2.Show
End Sub

Private Sub UserForm_Click()
MsgBox "Please Choose your Departement"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)


If CloseMode = 0 Then Cancel = True

End Sub


userform2


Private Sub CommandButton1_Click()
Sheet1.Unprotect Password:="123"
ActiveWorkbook.Unprotect Password:="123"
Application.Calculation = xlCalculationManual
Dim Password As String

Password = TextBox2.Text
If UserForm1.OptionButton1.Value = True And Password = "PM" Then
MsgBox "You Entered The Right Password..Go Ahead", vbInformation
Unload Me
Unload UserForm1
Sheet1.Unprotect Password:="123"
ActiveWorkbook.Unprotect Password:="123"
Columns.EntireColumn.Hidden = False
Sheet1.Range("z1:Z" & Cells.SpecialCells(11).Column).Interior.ColorIndex = 0
Sheet1.Range("M4:M" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 0
Sheet1.Range("AM4:AM" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 0
Sheet1.Range("AP4:AP" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 0
Sheet1.Range("AQ4:AQ" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 0
Range("M1:O1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("J1:L1").Select
Selection.Copy
Range("M1:O1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
UserInterfaceOnly = True
Application.Calculation = xlCalculationAutomatic
Else
If UserForm1.OptionButton2.Value = True And Password = "ENG" Then
MsgBox "You Entered The Right Password..Go Ahead", vbInformation
Unload Me
Unload UserForm1
Sheet1.Unprotect Password:="123"
ActiveWorkbook.Unprotect Password:="123"
Sheet1.Range("B:AQ").EntireColumn.Hidden = True

Sheet1.Range("A:G").EntireColumn.Hidden = False
Sheet1.Range("J:J").EntireColumn.Hidden = False
Sheet1.Range("M:M").EntireColumn.Hidden = False
Sheet1.Range("AE:AE").EntireColumn.Hidden = False
Sheet1.Range("AH:AH").EntireColumn.Hidden = False
Sheet1.Range("AL:AQ").EntireColumn.Hidden = False

Range("M1:O1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge

Range("M1").HorizontalAlignment = xlCenter
Range("M1").VerticalAlignment = xlBottom
Range("M1").WrapText = True

Range("B1").EntireColumn.Select
Selection.Copy
Range("A1").EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Columns.EntireColumn.Locked = True

Sheet1.Range("M5").EntireColumn.Locked = False

Sheet1.Range("AM5").EntireColumn.Locked = False

Sheet1.Range("AP5").EntireColumn.Locked = False


Sheet1.Range("M4:M" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("AM4:AM" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("AP4:AP" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("A1").EntireRow.Interior.ColorIndex = 0

Sheet1.Protect Password:="123"
ActiveWorkbook.Protect Password:="123"
UserInterfaceOnly = True
Application.Calculation = xlCalculationAutomatic
Else


If UserForm1.OptionButton3.Value = True And Password = "PRO" Then
MsgBox "You Entered The Right Password..Go Ahead", vbInformation
Unload Me
Unload UserForm1
Sheet1.Unprotect Password:="123"
ActiveWorkbook.Unprotect Password:="123"

Columns.EntireColumn.Hidden = False



Sheet1.Unprotect Password:="123"
ActiveWorkbook.Unprotect Password:="123"

Range("M1:O1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge

Range("R1").EntireColumn.Select
Selection.Copy
Range("X1").EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheet1.Range("N4:N" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("M4:M" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("P4:P" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("O3").Interior.ColorIndex = 20
Sheet1.Range("Q4:Q" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("S4:S" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("T4:T" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("V4:V" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("W4:W" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("Y4:Y" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("Z4:Z" & Cells.SpecialCells(11).Row).Interior.ColorIndex = 20
Sheet1.Range("A1").EntireRow.Interior.ColorIndex = 0


Range("W1").EntireColumn.Select
Selection.Copy
Range("Z1").EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("B1").EntireColumn.Select
Selection.Copy
Range("A1").EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheet1.Range("AH:AI").EntireColumn.Hidden = True
Sheet1.Range("AL:AL").EntireColumn.Hidden = True
Sheet1.Range("AM:AN").EntireColumn.Hidden = True
Columns.EntireColumn.Locked = True

Sheet1.Range("N5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("M5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("O3").Select
Selection.Locked = False
Sheet1.Range("P5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("Q5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("S5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("T5").EntireColumn.Select
Selection.Locked = False

Sheet1.Range("V5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("W5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("Y5").EntireColumn.Select
Selection.Locked = False
Sheet1.Range("Z5").EntireColumn.Select
Selection.Locked = False

Selection.WrapText = True
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlBottom

Range("M1:O1").Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("J1:L1").Select
Selection.Copy
Range("M1:O1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False



Sheet1.Protect Password:="123"
ThisWorkbook.Protect Password:="123"
UserInterfaceOnly = True
Application.Calculation = xlCalculationAutomatic
Else
MsgBox " You entered Wrong Password...Bye bye ", vbCritical
ActiveWorkbook.Close
Application.Calculation = xlCalculationAutomatic
End If
End If
End If
End Sub


Module1
Sub get_data()

Dim fullPath As String
Dim filePath As String
Dim fileName As String
Dim i As Integer
Dim rng1 As Range
Dim lastrow As Long


lastrow = ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row


fullPath = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "Please select filename", , False)

fileName = Mid(fullPath, InStrRev(fullPath, "") + 1)
filePath = Left(fullPath, InStrRev(fullPath, ""))


For i = 1 To lastrow



Range("M5:M" & lastrow).Formula = "=vlookup( A4,'" & filePath & "[" & fileName & "]Sheet1'!$A$1:$B$900,2,FALSE)"



Next


End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Have to tried to put i on the next?

For i = 1 To lastrow



Range("M5:M" & lastrow).Formula = "=vlookup( A4,'" & filePath & "[" & fileName & "]Sheet1'!$A$1:$B$900,2,FALSE)"



Next i


 
Upvote 0
@ rickjason and bebo201022,

Code: 
Range("M5:M" & lastrow).Formula = "=vlookup( A4,'" & filePath & "[" & fileName & "]Sheet1'!$A$1:$B$900,2,FALSE)"

already puts the formula in the whole range without putting in a loop.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
code to include a column or more based on checkbox
Replies
6
Views
124
mecerrato
M
C
  • Solved
Need Help VBA
2
Replies
10
Views
410
Trebor76
T
M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
468
MagicCarpet
M
A
  • Question Question
Save as dialogue box for excel, but pre populating filename from source word document
Replies
8
Views
235
RoryA
RoryA
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
199
jularobert
J

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top