Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() I am having an intermittant problem with some VBA that I am unable to resolve, and write in hope that someone can point me in the right direction! The following two lines of code occasionally fail to find what is there! Sheets("VS").Columns("B").Find(what:=rng).Offset(0 , 8) = Sheets("VS").Columns("B").Find(what:=rng).Offset(0 , 8) + rng.Offset(0, 4) Application.StatusBar = Cells(Target.Row, 3) & " Changed from " & Sheets("VS").Columns("B").Find(what:=Cells(Target. Row, 3), LookAt:=xlWhole).Offset(0, ofSt) Please note, other "Fnd" commands work ok when the above two lines stop working! These lines of code are in seperate macros in a substantial workbook that has been wrote over many years and performs faultlessly 95% of the time, however, occasionally the above lines stops working. The problem is rectified by closing the entire application down then reopening the application and workbook. Everything will then work fine until the next time it curiously stops. I have noted below the two subs that these lines are in. Note these are onlt two macros out of about 80 in this workbook. Sub showStocka() Dim totI, totO, totC, totT, totR, totV, cnt, anChor Application.EnableEvents = False Application.ScreenUpdating = False 'initial tests for records If Len(Sheets("Reference").Range("C2").Offset(Sheets( "Reference").Range("C2") + 1, 1)) < 11 Then MsgBox "No Stock Records" Application.EnableEvents = True Exit Sub End If On Error Resume Next Sheets("SS").Select Columns("I:I").Find(what:=Sheets("Reference").Rang e("C2").Offset(Sheets("Ref erence").Range("C2") + 1, 1)).Select If Err Then MsgBox "Macro Problem, main reference not found on stock sheet" Sheets("Stock Control").Select Application.EnableEvents = True Exit Sub End If On Error GoTo 0 'prepare VS sheet and copy in data Sheets("VS").Select ActiveSheet.Unprotect Range("$A$1", Selection.SpecialCells(xlLastCell)).ClearContents Sheets("SS").Select Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 1).End(xlDown).Offset(0, 29)).Select Selection.Copy Sheets("VS").Select Range("B3").PasteSpecial Paste:=xlValues Sheets("SS").Range("P1:AD1").Copy Range("Q3").PasteSpecial Paste:=xlValues anChor = Range("B3").End(xlDown).Offset(1, 0).Address Sheets("OX").Select Range(Range("A1"), Range("A30000").End(xlUp)).Select cnt = 0 For Each rng In Selection If Len(rng) = 5 And Left(rng, 2) = Sheets("VS").Range("C3") Then On Error Resume Next Sheets("VS").Columns("B").Find(what:=rng).Offset(0 , 8) = Sheets("VS").Columns("B").Find(what:=rng).Offset(0 , 8) + rng.Offset(0, 4) If Err Then On Error GoTo 0 Sheets("VS").Range(anChor).Offset(cnt, 0) = rng Sheets("VS").Range(anChor).Offset(cnt, 1) = rng.Offset(0, 1) Sheets("VS").Range(anChor).Offset(cnt, 2) = rng.Offset(0, 2) Sheets("VS").Range(anChor).Offset(cnt, 3) = rng.Offset(0, 3) Sheets("VS").Range(anChor).Offset(cnt, 8) = rng.Offset(0, 4) Sheets("VS").Range(anChor).Offset(cnt, 11) = rng.Offset(0, 7) Sheets("VS").Range(anChor).Offset(cnt, 12) = rng.Offset(0, 8) Sheets("VS").Range(anChor).Offset(cnt, 13) = "N" cnt = cnt + 1 End If On Error GoTo 0 End If Next rng Sheets("VS").Select Range("B4").Select If Range("B5") < "" Then Range("B4", Cells(4, 2).End(xlDown)).Select totV = 0: totI = 0: totO = 0: totC = 0: totR = 0: totT = 0 For Each rng In Selection rng.Offset(0, -1) = Right(rng, 3) / 1 totV = totV + rng.Offset(0, 9) * rng.Offset(0, 11) totT = totT + rng.Offset(0, 11) totR = totR + rng.Offset(0, 12) If rng.Offset(0, 9) 0 Then totI = totI + 1 Else totO = totO + 1 End If If rng.Offset(0, 10) = "X" Then totC = totC + 1 Next rng Range("A1") = totV Range("B1") = totI Range("C1") = totO Range("D1") = totC Range("E1") = totR / totT 'sets view Columns("E").ColumnWidth = 0 Columns("F").ColumnWidth = 0 Columns("Q").ColumnWidth = 0 Columns("H").ColumnWidth = 0 Range("A4:AA4").Select ActiveWindow.Zoom = True If Range("A5") < "" Then Range("A4", Cells(4, 1).End(xlDown).Offset(0, 31)).Select Range("A4", Cells(4, 1).End(xlDown).Offset(0, 31)).Sort Key1:=Range("A4"), Order1:=xlAscending End If Range("A2") = "A4" 'see sort routine Range("A4").Select ActiveSheet.DrawingObjects("ModeBox").Characters.T ext = "View Only" ActiveSheet.DrawingObjects("ViewOnlyButGroup").Bri ngToFront ActiveSheet.DrawingObjects("EditViewButGroup").Sen dToBack ActiveSheet.DrawingObjects("OrderButGroup").SendTo Back ActiveSheet.DrawingObjects("But_ViewOrder").SendTo Back Columns("A:AE").Locked = True ActiveSheet.Protect Application.OnTime Now, "fixView" With ActiveWindow .DisplayHeadings = False .DisplayHorizontalScrollBar = False .DisplayWorkbookTabs = False .DisplayVerticalScrollBar = True End With With Application .DisplayFormulaBar = False .DisplayStatusBar = True End With Application.EnableEvents = True glb_LineOnOff = 0 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim ofSt As Integer If Target.Interior.ColorIndex = 36 Then If Target.Column 6 Then ofSt = Target.Column + 1 Else ofSt = Target.Column - 3 End If Application.StatusBar = Cells(Target.Row, 3) & " Changed from " & Sheets("VS").Columns("B").Find(what:=Cells(Target. Row, 3), LookAt:=xlWhole).Offset(0, ofSt) Else Application.StatusBar = False End If End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
application.match and value problem | Excel Discussion (Misc queries) | |||
Problem with application.Hlookup | Excel Discussion (Misc queries) | |||
Application.WorksheetFunction.Match problem | Excel Worksheet Functions | |||
Problem with closing the excel application | Excel Programming | |||
Problem in running an application | Excel Programming |