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

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
 

rickjason

New Member
Joined
Jan 9, 2014
Messages
27
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


 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
11,471
Office Version
365, 2010
Platform
Windows, Mobile
@ 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:

Forum statistics

Threads
1,081,702
Messages
5,360,743
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top