View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Stuart[_10_] Stuart[_10_] is offline
external usenet poster
 
Posts: 12
Default Application Problem


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