Hi,
Every time I run this code in Excel 2010 am always getting error like " Microsoft Excel has stop working".
Please see my code below and let me know what I am doing wrong? if I use only code writen in Green then I am not getting this error. But When I add another code writen in RED then I am geetting this error msg.
Please help!
Public a As String
Sub PE_Sample()
Dim MyPath As String
Dim MyName As String
Dim PName As String
Dim WrkBk As String
Dim PRDS As Object
Dim Final_File As Object
Dim Rng_Look As Range
Dim Yr As Long
Dim GIS As String
Dim C_Name As String
Dim i As Integer
Dim LastRow As Integer
Dim S As String
Dim F As String
'-------------- Error Handling--------------
'On Error GoTo er:
MyPath = ActiveWorkbook.Path
MyName = ActiveWorkbook.Name
Yr = ActiveWorkbook.Worksheets("Instructions").Range("E13").Value
Workbooks.Open MyPath & "\W3000MT-Hotel Property"
Windows("W3000MT-Hotel Property.xlsx").Activate
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Select
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A2") = "a"
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A5") = "a"
WrkBk = ActiveWorkbook.Name
Range("A5").Formula = "=LEFT(MID(A4,FIND(""="",A4)+11,550),FIND("") And ("",MID(A4,FIND(""="",A4)+11,550))-1)"
Range("C5").Formula = "=MID(A4,FIND(""="",A4,1)+2,4)"
Range("B5").Formula = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(CLEAN(A5)),""$"","" ""),""/"","" ""),""?"","" ""),""\"","" ""),CHAR(152),"" "")"
ActiveSheet.Calculate
Range("A5:C5").Select
Range("A5:C5").Copy
Selection.PasteSpecial Paste:=xlPasteValues
'-------------- Find GIS------------------------
GIS = Range("C5").Value
C_Name = Range("B5").Value
Range("A5:B5").Value = ""
'------------ Active Hotel Saving File -----------------
Windows(MyName).Activate
ActiveWorkbook.Worksheets("Instructions").Select
Range("H9").Value = C_Name
'-------------- Conditions Checks-----------------------
If ActiveWorkbook.Worksheets("Instructions").Range("O7") = "" Then
MsgBox "Please enter YES/NO in cell O7"
Range("O7").Select
Exit Sub
End If
If ActiveWorkbook.Worksheets("Instructions").Range("L8") = "" Then
MsgBox "Please enter GIS Code in cell L8"
Range("L8").Select
Exit Sub
End If
If Range("L8") <> GIS Then
MsgBox "GIS code not matching with Raw Data", vbCritical
Exit Sub
End If
If ActiveWorkbook.Worksheets("Instructions").Range("H9") = "" Then
MsgBox "Please enter Client Name in cell H9"
Range("H9").Select
Exit Sub
End If
'---------Update deatils in Raw Data Input Tab----------------------
Windows("W3000MT-Hotel Property.xlsx").Activate
Set Hotel_raw_data = ActiveWorkbook
LastRow = Worksheets("W3000MT-Hotel Property").Cells(65536, 1).End(xlUp).Row
i = 2
H = "Hotel Name"
Do
If Worksheets("W3000MT-Hotel Property").Range("a" & i + 1) = H Then
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A" & i + 1 & ":J" & LastRow).Select
Selection.Copy
Exit Do
Else
i = i + 1
End If
Loop Until Worksheets("W3000MT-Hotel Property").Cells(i, 1).Value = H
'--------- Paste Data in Raw Data Input Sheet ----------------------------
Windows(MyName).Activate
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2").Select
Columns("A:A").ColumnWidth = 17
Columns("A:A").ColumnWidth = 27
Rows("2:2").RowHeight = 35
Range("A2:T2").Select
'Application.CutCopyMode = False
' With Selection
' .VerticalAlignment = xlBottom
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
' End With
' Range("H3").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Style = "Currency"
' Selection.NumberFormat = "_($* #,##0.0_);_($* (#,##0.0);_($* ""-""??_);_(@_)"
' Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
' Range("J3").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Style = "Currency"
' Selection.NumberFormat = "_($* #,##0.0_);_($* (#,##0.0);_($* ""-""??_);_(@_)"
' Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
Range("K3").Select
'------------------- Format Raw Data Sheet------------------------
Columns("B:B").Select 'remove spaces in column B
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Calculate
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Calculate
'-------------------Refresh Pivot Tables--------------------------
ActiveWorkbook.Worksheets("Pivot (Savings) ").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Calculate
Range("H4").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Calculate
Range("B4").Select
'------------------- Output Sheet---------------------------------
ActiveWorkbook.Worksheets("Output").Activate
Range("B3").Select
S = ActiveWorkbook.Worksheets("Instructions").Range("H9").Value
F = Yr & "Hotel Saving Report - " & S
ActiveWorkbook.Worksheets("Output").Range("B2") = F
Range("B2").Select
'----------------- Raw Data Input Sheet---------------------------
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Range("K2:AL2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
'------------------ Delete Non-Required Sheets---------------------
ActiveWorkbook.Worksheets("Instructions").Delete
ActiveWorkbook.Worksheets("Complete Suite Hotel Table").Delete
ActiveWorkbook.Worksheets("Pref Extras Prop Level Table").Delete
ActiveWindow.SelectedSheets.Visible = False
ActiveWorkbook.Worksheets("Output").Activate
Calculate
'------------------ Save Workbook----------------------------------
ActiveWorkbook.SaveAs F
Set Final_File = ActiveWorkbook
Workbooks.Open MyPath & "\MM Clients PRDS Data_New"
'Set PRDS = ActiveWorkbook
ActiveWorkbook.Worksheets("Sheet1").Select
PRDS_LR = ActiveWorkbook.Worksheets("Sheet1").Cells(160000, 1).End(xlUp).Row
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=GIS
Range("A1:AE" & PRDS_LR).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'************Paste data into Final File******************************
Final_File.Activate
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
Sheets("Sheet1").Select
ActiveSheet.Name = "Client_Negotiated_Data"
Range("A1").Select
ActiveSheet.Paste
'er:
' If Err.Number > 0 Then
' MsgBox Err.Description, vbOKOnly
' Exit Sub
' End If
End Sub
Every time I run this code in Excel 2010 am always getting error like " Microsoft Excel has stop working".
Please see my code below and let me know what I am doing wrong? if I use only code writen in Green then I am not getting this error. But When I add another code writen in RED then I am geetting this error msg.
Please help!
Public a As String
Sub PE_Sample()
Dim MyPath As String
Dim MyName As String
Dim PName As String
Dim WrkBk As String
Dim PRDS As Object
Dim Final_File As Object
Dim Rng_Look As Range
Dim Yr As Long
Dim GIS As String
Dim C_Name As String
Dim i As Integer
Dim LastRow As Integer
Dim S As String
Dim F As String
'-------------- Error Handling--------------
'On Error GoTo er:
MyPath = ActiveWorkbook.Path
MyName = ActiveWorkbook.Name
Yr = ActiveWorkbook.Worksheets("Instructions").Range("E13").Value
Workbooks.Open MyPath & "\W3000MT-Hotel Property"
Windows("W3000MT-Hotel Property.xlsx").Activate
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Select
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A2") = "a"
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A5") = "a"
WrkBk = ActiveWorkbook.Name
Range("A5").Formula = "=LEFT(MID(A4,FIND(""="",A4)+11,550),FIND("") And ("",MID(A4,FIND(""="",A4)+11,550))-1)"
Range("C5").Formula = "=MID(A4,FIND(""="",A4,1)+2,4)"
Range("B5").Formula = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(CLEAN(A5)),""$"","" ""),""/"","" ""),""?"","" ""),""\"","" ""),CHAR(152),"" "")"
ActiveSheet.Calculate
Range("A5:C5").Select
Range("A5:C5").Copy
Selection.PasteSpecial Paste:=xlPasteValues
'-------------- Find GIS------------------------
GIS = Range("C5").Value
C_Name = Range("B5").Value
Range("A5:B5").Value = ""
'------------ Active Hotel Saving File -----------------
Windows(MyName).Activate
ActiveWorkbook.Worksheets("Instructions").Select
Range("H9").Value = C_Name
'-------------- Conditions Checks-----------------------
If ActiveWorkbook.Worksheets("Instructions").Range("O7") = "" Then
MsgBox "Please enter YES/NO in cell O7"
Range("O7").Select
Exit Sub
End If
If ActiveWorkbook.Worksheets("Instructions").Range("L8") = "" Then
MsgBox "Please enter GIS Code in cell L8"
Range("L8").Select
Exit Sub
End If
If Range("L8") <> GIS Then
MsgBox "GIS code not matching with Raw Data", vbCritical
Exit Sub
End If
If ActiveWorkbook.Worksheets("Instructions").Range("H9") = "" Then
MsgBox "Please enter Client Name in cell H9"
Range("H9").Select
Exit Sub
End If
'---------Update deatils in Raw Data Input Tab----------------------
Windows("W3000MT-Hotel Property.xlsx").Activate
Set Hotel_raw_data = ActiveWorkbook
LastRow = Worksheets("W3000MT-Hotel Property").Cells(65536, 1).End(xlUp).Row
i = 2
H = "Hotel Name"
Do
If Worksheets("W3000MT-Hotel Property").Range("a" & i + 1) = H Then
ActiveWorkbook.Worksheets("W3000MT-Hotel Property").Range("A" & i + 1 & ":J" & LastRow).Select
Selection.Copy
Exit Do
Else
i = i + 1
End If
Loop Until Worksheets("W3000MT-Hotel Property").Cells(i, 1).Value = H
'--------- Paste Data in Raw Data Input Sheet ----------------------------
Windows(MyName).Activate
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2").Select
Columns("A:A").ColumnWidth = 17
Columns("A:A").ColumnWidth = 27
Rows("2:2").RowHeight = 35
Range("A2:T2").Select
'Application.CutCopyMode = False
' With Selection
' .VerticalAlignment = xlBottom
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
' End With
' Range("H3").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Style = "Currency"
' Selection.NumberFormat = "_($* #,##0.0_);_($* (#,##0.0);_($* ""-""??_);_(@_)"
' Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
' Range("J3").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Style = "Currency"
' Selection.NumberFormat = "_($* #,##0.0_);_($* (#,##0.0);_($* ""-""??_);_(@_)"
' Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
Range("K3").Select
'------------------- Format Raw Data Sheet------------------------
Columns("B:B").Select 'remove spaces in column B
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Calculate
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Calculate
'-------------------Refresh Pivot Tables--------------------------
ActiveWorkbook.Worksheets("Pivot (Savings) ").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Calculate
Range("H4").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Calculate
Range("B4").Select
'------------------- Output Sheet---------------------------------
ActiveWorkbook.Worksheets("Output").Activate
Range("B3").Select
S = ActiveWorkbook.Worksheets("Instructions").Range("H9").Value
F = Yr & "Hotel Saving Report - " & S
ActiveWorkbook.Worksheets("Output").Range("B2") = F
Range("B2").Select
'----------------- Raw Data Input Sheet---------------------------
ActiveWorkbook.Worksheets("Raw Data Input").Activate
Range("K2:AL2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
'------------------ Delete Non-Required Sheets---------------------
ActiveWorkbook.Worksheets("Instructions").Delete
ActiveWorkbook.Worksheets("Complete Suite Hotel Table").Delete
ActiveWorkbook.Worksheets("Pref Extras Prop Level Table").Delete
ActiveWindow.SelectedSheets.Visible = False
ActiveWorkbook.Worksheets("Output").Activate
Calculate
'------------------ Save Workbook----------------------------------
ActiveWorkbook.SaveAs F
Set Final_File = ActiveWorkbook
Workbooks.Open MyPath & "\MM Clients PRDS Data_New"
'Set PRDS = ActiveWorkbook
ActiveWorkbook.Worksheets("Sheet1").Select
PRDS_LR = ActiveWorkbook.Worksheets("Sheet1").Cells(160000, 1).End(xlUp).Row
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=GIS
Range("A1:AE" & PRDS_LR).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'************Paste data into Final File******************************
Final_File.Activate
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
Sheets("Sheet1").Select
ActiveSheet.Name = "Client_Negotiated_Data"
Range("A1").Select
ActiveSheet.Paste
'er:
' If Err.Number > 0 Then
' MsgBox Err.Description, vbOKOnly
' Exit Sub
' End If
End Sub
