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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
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

G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
363
rlv01
R
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
283
offthelip
O
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
332
RoryA
RoryA
S
  • Question
vba logic to open up several files within a folder and perform 2-3 steps
Replies
1
Views
114
ranman256
ranman256
B
  • Solved
VBA Help - Same Function needed for multiple sheets
Replies
2
Views
243
birdman15
B

Forum statistics

Threads
1,214,990
Messages
6,122,625
Members
449,093
Latest member
catterz66

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