vba hangs when the code referres to a label

frecol

New Member
Joined
Nov 25, 2014
Messages
2
The code below stops executing at the line: St2: Company = Work.Cells(1, 1).Value and hangs. This sub is part of a module with only one other sub that stores the input values (aquired through form Input_prop) in a worksheet: see line: Call Prop_write(Propnum).e. When entering the sub, the sheet Work is active. Thanks for your assistance! :)

Option Explicit
Option Base 1
Sub Inp_prop()
Dim Propout As Date, propok As Date, Rema As String
Dim aday As String, amon As String, ayear As String, bday As String, bmon As String, byear As String, sysdate As Date
Dim oday As String, omon As String, oyear As String
Dim i As Integer, j As Integer
Work.Range("a1:e98").ClearContents
If Subname = "Rec_add" Then
GoTo St
End If
' get the existing data
Company = Props.Cells(Propnum, 1).Value
Project = Props.Cells(Propnum, 2).Value
Propout = Props.Cells(Propnum, 3).Value
propok = Props.Cells(Propnum, 4).Value
Rema = Props.Cells(Propnum, 5).Value
ID = Props.Cells(Propnum, 6).Value
' decompose data and store in de cells used by Input_prop
Work.Activate
Work.Range("a1").Value = Company
Work.Range("a2").Value = Project
Call Decdate(oday, omon, oyear, Propout)
Work.Cells(1, 2).Value = oday
Work.Cells(2, 2).Value = omon
Work.Cells(3, 2).Value = oyear
If propok = 0 Then
Work.Cells(4, 2).Value = ""
Work.Cells(5, 2).Value = ""
Work.Cells(6, 2).Value = ""
Else
Call Decdate(oday, omon, oyear, propok)
Work.Cells(4, 2).Value = oday
Work.Cells(5, 2).Value = omon
Work.Cells(6, 2).Value = oyear
End If
St: Canc = False
Input_prop.Show
If Canc = True Then
Exit Sub
End If
aday = Work.Cells(1, 2).Value
amon = Work.Cells(2, 2).Value
ayear = Work.Cells(3, 2).Value
Call Make_date(aday, amon, ayear, Propout)
bday = Work.Cells(4, 2).Value
If bday = "" Then
GoTo St2
End If
bmon = Work.Cells(5, 2).Value
byear = Work.Cells(6, 2).Value
Call Make_date(bday, bmon, byear, propok)
Call ER_date(aday, amon, ayear, Propout, bday, bmon, byear, propok)
Work.Range("a3").Value = Propout
Work.Range("a4").Value = propok
St2: Company = Work.Cells(1, 1).Value
Project = Work.Cells(2, 1).Value
Work.Activate
If Subname = "Rec_add" Then
Proprec = Proprec + 1
Propnum = Proprec + 1
ID = Company & "-" & Propout & "-" & Str(Proprec)
Work.Range("ac1").Value = Proprec
Work.Cells(Proprec, 18).Select
ActiveCell.Value = Company
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ID
End If
' check if the company name exists
Work.Range("AA1").Select
i = 0
j = 0
Do While ActiveCell.Value <> ""
If ActiveCell.Value <> Company Then
j = j + 1
End If
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
If i = j Then
ActiveCell.Value = Company
Ncomp = Ncomp + 1
Work.Range("ad1").Value = Ncomp
Call Sort_app(Work, 1, 27, Ncomp, 28)
End If
'check if the project name exists
Work.Range("AB1").Select
i = 0
j = 0
Do While ActiveCell.Value <> ""
If ActiveCell.Value <> Project Then
j = j + 1
End If
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
If i = j Then
ActiveCell.Value = Project
Nproj = Nproj + 1
Work.Range("ad2").Value = Nproj
Call Sort_app(Work, 1, 28, Nproj, 28)
End If
Call Prop_write(Propnum)
Cont_input.Show
Call Main
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Did you ever get this to work?<o:p></o:p>
<o:p> </o:p>
I don't see a reason that it wouldn't work.<o:p></o:p>
<o:p> </o:p>
If you post the entire program I'll try to execute it &see what happens.<o:p></o:p>
<o:p> </o:p>
Bob
 
Upvote 0
Thanks. Indeed it did work flawlessly. It stopt working after adding a new module & sub to the application.
I'll try to figure it out since I don't want to abuse your time and efforts to check thousands of lines of code.

Freddy
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top