Transcend Time in Excel

[aehresma]

I work on a production line that has 326 hangers which we connect different fixtures to. I wanted to create a visual tool for the loaders to help aid them in knowing what fixtures are coming etc.

I already have a simple table like so that i layout the line with in excel...

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]Part A
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Part B
[/TD]
[/TR]
[TR]
[TD]....
[/TD]
[TD]....
[/TD]
[/TR]
[TR]
[TD]326
[/TD]
[TD]Part C
[/TD]
[/TR]
</tbody>[/TABLE]

Some notes:
The hangers move spaces every 25.4 seconds so I wanted to create a display that would reference the "Part Type" but that would auto refresh every 25.4 seconds and display the next Part down in the list.
The inspectors control the excel spreadsheet that currently has the above table. the layout stays pretty constant but They make updates if we make any part changes as the day goes.


Some other features I would need are the following...
- for the display to go back to referencing fixture 1 once it gets to 326
- a field where the inspectors can true up what fixture is passing by them at the current moment in case the timing is off due to line stops. The extra curve ball to this feature is if they put in fixture "10" for example... there are 12 fixtures between the inspectors and the loaders so if they put in "10" and hit "update" the display would have to add the 12 fixture locations back to the display.


**someone created such a display/tab in excel once but there has been some changes made to the worksheet since then and this person was able to create this with SEVERAL workarounds that I tried to trace the logic but was driving me crazy =)

Any help would be greatly appreciated and if you have any questions I will answer.

Thanks!!

 

[mole999]

if the code exists, post it between code tags here

 

[aehresma]

ption Explicit
Dim bBreak As Boolean

Sub Butt*******()
    bBreak = True
  


End Sub

Sub Main()
    Dim X As Long
    Dim i As Long
    bBreak = False
    Dim z As Integer
    z = 0
    
    Do While True
        X = 1000
        For i = 1 To X
            If bBreak Then
                Exit Do
            End If
            DoEvents
        Next

        For i = X To 1 Step -1
            If bBreak Then
                Exit Do
            End If
            DoEvents
        Next
    Loop
    If bBreak Then XYZ
End Sub



Sub GoToHook()
    bBreak = False
'
Dim z As Integer
Dim OffsetHook As Integer
Dim offhook2 As Integer

Sheets("Validate").Select
'ActiveSheet.Range(Cells(GameDay + 1, 11), Cells(400, 11)).Value = ASRLTValueL
z = 0
OffsetHook = ThisWorkbook.Sheets("AllHC").Range("ar10").Value
ThisWorkbook.Sheets("AllHC").Range("ao14").Value = OffsetHook



'RunTimer
End Sub

Sub ChangeActual()
bBreak = False
'
Dim z As Integer
Dim NewHook As Integer
Dim NewPart As String
Sheets("Validate").Select

'ActiveSheet.Range(Cells(GameDay + 1, 11), Cells(400, 11)).Value = ASRLTValueL
z = 0
NewHook = ActiveSheet.Range("L3").Value
If NewHook = 0 Then
MsgBox ("Please specify Hook Number")
Exit Sub
End If

NewPart = ActiveSheet.Range("L5").Value
'ThisWorkbook.Sheets("All").Range(Cells(NewHook + 1, 2), Cells(NewHook + 1, 2)).Value = NewPart
'ThisWorkbook.Sheets("All").Range(NewHook + 1, 2).Value = NewPart
Sheets("All").Select
        Sheets("Part List").Unprotect Password:="helpme"
Cells(NewHook + 1, 2).Value = NewPart
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Validate").Select
'RunTimer

End Sub
Sub RunTimer()
 ' code here
Application.Calculation = xlAutomatic
    bBreak = False
Dim z As Integer

Do
' Macro2 Macro
z = z + 1
Application.Wait (Now + TimeValue("0:00:01"))
'
    Calculate
                If bBreak Then
                Exit Do
            End If
            DoEvents
            z = z - 1
    Loop Until z > 1000
End Sub

Sub Button2_Click()
'
' Button2_Click Macro
'
Sheets("Validate").Select

    Range("J19").Select
End Sub
Sub Publish()
'
' Macro2 Macro
'
'Sheets("Sheet1").Unprotect Password:="secret"



'
    Sheets("AllHC").Select
    ActiveSheet.Unprotect
    Range("Ag52").Value = Now()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("All").Select
    'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("All").Protect Password:="helpme"
    Sheets("Part List").Select
        Sheets("Part List").Protect Password:="helpme"
End Sub
Sub Macro4()
'
' Macro4 Macro
'

'
    Sheets("AllHC").Select
    ActiveSheet.Unprotect
    Range("AG52").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Part List").Select
End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("All").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("X8").Select
    ActiveSheet.Unprotect
    Sheets("Validate").Select
End Sub

I actually was able to get it to run. I saw that he had to unprotect and protect the sheets and I had changed the password since he left. When I updated that it now runs.
one issue I still have is this thing really seems to bog down the program. I feel like there should be a simpler way to accomplish what we need. Any advice on how to clean it up? I know I'm not able to give you a whole lot. If anyone would like to see the file let me know.