Listbox problem agaie

R

ranswrt

If anyone can help me with this it would be greatly appreciated.

I have the following procedure that works good except for the end on call
loadlistbox. The value in the listbox doesn't change. I have the codes for
loadlistbox, stopautocalc, and startautocalc at the end of this post.
Loadlistbox does work when ran independently and when it is called from other
procedures

Sub previousestimate()
Dim fcell As Range
Dim code As String
Dim i As Integer
Dim xcell As Range
Dim ycell As Range
Dim a() As Variant
Dim chk As Excel.CheckBox
Dim cnt As Integer
Dim x As Integer
Dim j As Integer
Dim z As String
Dim rng As Range
Dim subcat As String
Dim est As String
Dim cst As String



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



est = Sheets("Estimates DB").Range("currentestimate")
cst = Replace(est, "est", "cst")
estnum = Sheets("Estimates DB").Range("estimatenumber")
num = Sheets("Estimates").Range("estnum")

If cst = "cst01" Then
MsgBox ("This is the First Cost Item Estimate Sheet.")
Else
If num > 0 Then

Set xcell = Sheets("Estimates").Range("estlinkno")
For i = 1 To num
lnknum = xcell.Offset(i, 0)
ActiveSheet.Checkboxes("Checkbox" & est & lnknum).Delete
Next
Set xcell = Sheets("Estimates").Range("estno")
Range(xcell.Offset(1, 0), xcell.Offset(num, 6)).ClearContents
Sheets("Estimates").Range("estitemsrng").Locked = True
If num > 10 Then
Range(xcell.Offset(11, 0), xcell.Offset(num, 0)).EntireRow.Delete
With Range(xcell.Offset(10, 0), xcell.Offset(10,
5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Sheets("Estimates").Range("estnum") = 0
End If

Set rng = Sheets("Cost Items DB").Range("costitemidrng")
With rng
Set fcell = .Find(what:=cst, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With

cst = fcell.Offset(-1, 0)
est = Replace(cst, "cst", "est")
Sheets("Estimates DB").Range("currentestimate") = est
code = fcell.Offset(-1, -2)
costitem = fcell.Offset(-1, -1)
subcat = fcell.Offset(-1, 6)
Sheets("Estimates").Range("estcode") = code
Sheets("Estimates").Range("estitem") = costitem
Sheets("Estimates").Range("estsubcat") = "Sub Category of: " & subcat
If fcell.Offset(-1, 7) Then
Worksheets("Estimates").CheckBox1.Value = True
Else
Worksheets("Estimates").CheckBox1.Value = False
End If

If estnum > 0 Then
Set rng = Sheets("Estimates DB").Range("estdbidrng")
cnt = Application.WorksheetFunction.CountIf(rng, est)
ReDim a(cnt, 7)

If cnt > 10 Then
Set xcell = Sheets("Estimates").Range("estno")
For i = 10 To (cnt - 1)
xcell.Offset((i), 0).EntireRow.Insert
Next
End If

Set xcell = Sheets("Estimates DB").Range("estdbid")
num = 0
For i = 1 To estnum
If xcell.Offset(i, 0) = est Then
num = num + 1
Set fcell = xcell.Offset(i, 0)
a(num, 1) = fcell.Offset(0, 2)
a(num, 2) = fcell.Offset(0, 3)
a(num, 3) = fcell.Offset(0, 4)
a(num, 4) = fcell.Offset(0, 5)
a(num, 5) = fcell.Offset(0, 6)
a(num, 6) = fcell.Offset(0, 6).address
a(num, 7) = fcell.Offset(0, 6).address(ReferenceStyle:=xlR1C1)
End If
Next
For i = 1 To cnt
Set ycell = Sheets("Estimates").Range("estno")
ycell.Offset(i, 0) = i
ycell.Offset(i, 2) = a(i, 1)
ycell.Offset(i, 3) = a(i, 2)
ycell.Offset(i, 4) = a(i, 3)
ycell.Offset(i, 6) = a(i, 4)
lnknum = a(i, 4)
Set ycell = Sheets("Estimates").Range("estno").Offset(i, 1)
Set chk = ycell.Parent.Checkboxes.Add(ycell.Left, ycell.Top, 0,
ycell.Height)
chk.Height = ycell.Height - 1.5
chk.Characters.Text = ""
chk.Name = "Checkbox" & est & lnknum
z = a(i, 6)
z = "'Estimates DB'!" & z
chk.LinkedCell = z
chk.Visible = True
chk.Display3DShading = True
chk.OnAction = "updateestimatetotal"
If a(i, 5) Then
chk.Value = True
Else
chk.Value = False
End If
Set ycell = Sheets("estimates").Range("esttotal")
ycell.Offset(i, 0).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
ycell.Offset(i, 0).FormulaR1C1 = "=if('Estimates DB'!" & a(i, 7)
& ",RC[-1],0)"
Set ycell = Sheets("Estimates").Range("estno")
Range(ycell.Offset(i, 2), ycell.Offset(i, 4)).Locked = False
Next
Else
num = 0
End If

End If
Sheets("Estimates").Range("estnum") = num
Call nameestranges
Sheets("Estimates").Range("estno").Offset(num, 2).Select
addborders

Worksheets("Estimates").Protect Password:="6573"
Worksheets("Estimates DB").Protect Password:="6573"
Call startautocalc

Call loadlistbox

End Sub



I found that if I change this code at the beggining of the previousestimate
procedure from this



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



to this



Worksheets("Estimates db").Unprotect Password:="6573"
Call stopautocalc
Worksheets("Estimates").Unprotect Password:="6573"



the loadlistbox procedure that is called at the end works. The only problem
is that the screen flashes on the unprotect sheets at the beginning of the
code.

Sub loadlistbox()
Dim est As String
Dim xcell As Range
Dim fcell As Range
Dim rng As Range
Dim a() As String
Dim i As Long
Dim num As Long

Worksheets("Estimates").ListBox1.Clear
Set xcell = Sheets("Database Links").Range("estlnkdb")
Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
est = Sheets("Estimates DB").Range("currentestimate")
With rng
Set fcell = .Find(what:=est, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With
num = fcell.Offset(0, 1)
ReDim a(num)
For i = 1 To num
a(i) = fcell.Offset(i, 0)
Next
With Sheets("Estimates")
For i = 1 To num
With .ListBox1
.AddItem a(i)
End With
Next
End With

End Sub

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Sub startautocalc()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Again if someone can help me with this. I've tried everything I can think of.
Thank You
 
J

Joel

I suspect this range statement needs a reference to a worksheet

Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))

ranswrt said:
If anyone can help me with this it would be greatly appreciated.

I have the following procedure that works good except for the end on call
loadlistbox. The value in the listbox doesn't change. I have the codes for
loadlistbox, stopautocalc, and startautocalc at the end of this post.
Loadlistbox does work when ran independently and when it is called from other
procedures

Sub previousestimate()
Dim fcell As Range
Dim code As String
Dim i As Integer
Dim xcell As Range
Dim ycell As Range
Dim a() As Variant
Dim chk As Excel.CheckBox
Dim cnt As Integer
Dim x As Integer
Dim j As Integer
Dim z As String
Dim rng As Range
Dim subcat As String
Dim est As String
Dim cst As String



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



est = Sheets("Estimates DB").Range("currentestimate")
cst = Replace(est, "est", "cst")
estnum = Sheets("Estimates DB").Range("estimatenumber")
num = Sheets("Estimates").Range("estnum")

If cst = "cst01" Then
MsgBox ("This is the First Cost Item Estimate Sheet.")
Else
If num > 0 Then

Set xcell = Sheets("Estimates").Range("estlinkno")
For i = 1 To num
lnknum = xcell.Offset(i, 0)
ActiveSheet.Checkboxes("Checkbox" & est & lnknum).Delete
Next
Set xcell = Sheets("Estimates").Range("estno")
Range(xcell.Offset(1, 0), xcell.Offset(num, 6)).ClearContents
Sheets("Estimates").Range("estitemsrng").Locked = True
If num > 10 Then
Range(xcell.Offset(11, 0), xcell.Offset(num, 0)).EntireRow.Delete
With Range(xcell.Offset(10, 0), xcell.Offset(10,
5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Sheets("Estimates").Range("estnum") = 0
End If

Set rng = Sheets("Cost Items DB").Range("costitemidrng")
With rng
Set fcell = .Find(what:=cst, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With

cst = fcell.Offset(-1, 0)
est = Replace(cst, "cst", "est")
Sheets("Estimates DB").Range("currentestimate") = est
code = fcell.Offset(-1, -2)
costitem = fcell.Offset(-1, -1)
subcat = fcell.Offset(-1, 6)
Sheets("Estimates").Range("estcode") = code
Sheets("Estimates").Range("estitem") = costitem
Sheets("Estimates").Range("estsubcat") = "Sub Category of: " & subcat
If fcell.Offset(-1, 7) Then
Worksheets("Estimates").CheckBox1.Value = True
Else
Worksheets("Estimates").CheckBox1.Value = False
End If

If estnum > 0 Then
Set rng = Sheets("Estimates DB").Range("estdbidrng")
cnt = Application.WorksheetFunction.CountIf(rng, est)
ReDim a(cnt, 7)

If cnt > 10 Then
Set xcell = Sheets("Estimates").Range("estno")
For i = 10 To (cnt - 1)
xcell.Offset((i), 0).EntireRow.Insert
Next
End If

Set xcell = Sheets("Estimates DB").Range("estdbid")
num = 0
For i = 1 To estnum
If xcell.Offset(i, 0) = est Then
num = num + 1
Set fcell = xcell.Offset(i, 0)
a(num, 1) = fcell.Offset(0, 2)
a(num, 2) = fcell.Offset(0, 3)
a(num, 3) = fcell.Offset(0, 4)
a(num, 4) = fcell.Offset(0, 5)
a(num, 5) = fcell.Offset(0, 6)
a(num, 6) = fcell.Offset(0, 6).address
a(num, 7) = fcell.Offset(0, 6).address(ReferenceStyle:=xlR1C1)
End If
Next
For i = 1 To cnt
Set ycell = Sheets("Estimates").Range("estno")
ycell.Offset(i, 0) = i
ycell.Offset(i, 2) = a(i, 1)
ycell.Offset(i, 3) = a(i, 2)
ycell.Offset(i, 4) = a(i, 3)
ycell.Offset(i, 6) = a(i, 4)
lnknum = a(i, 4)
Set ycell = Sheets("Estimates").Range("estno").Offset(i, 1)
Set chk = ycell.Parent.Checkboxes.Add(ycell.Left, ycell.Top, 0,
ycell.Height)
chk.Height = ycell.Height - 1.5
chk.Characters.Text = ""
chk.Name = "Checkbox" & est & lnknum
z = a(i, 6)
z = "'Estimates DB'!" & z
chk.LinkedCell = z
chk.Visible = True
chk.Display3DShading = True
chk.OnAction = "updateestimatetotal"
If a(i, 5) Then
chk.Value = True
Else
chk.Value = False
End If
Set ycell = Sheets("estimates").Range("esttotal")
ycell.Offset(i, 0).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
ycell.Offset(i, 0).FormulaR1C1 = "=if('Estimates DB'!" & a(i, 7)
& ",RC[-1],0)"
Set ycell = Sheets("Estimates").Range("estno")
Range(ycell.Offset(i, 2), ycell.Offset(i, 4)).Locked = False
Next
Else
num = 0
End If

End If
Sheets("Estimates").Range("estnum") = num
Call nameestranges
Sheets("Estimates").Range("estno").Offset(num, 2).Select
addborders

Worksheets("Estimates").Protect Password:="6573"
Worksheets("Estimates DB").Protect Password:="6573"
Call startautocalc

Call loadlistbox

End Sub



I found that if I change this code at the beggining of the previousestimate
procedure from this



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



to this



Worksheets("Estimates db").Unprotect Password:="6573"
Call stopautocalc
Worksheets("Estimates").Unprotect Password:="6573"



the loadlistbox procedure that is called at the end works. The only problem
is that the screen flashes on the unprotect sheets at the beginning of the
code.

Sub loadlistbox()
Dim est As String
Dim xcell As Range
Dim fcell As Range
Dim rng As Range
Dim a() As String
Dim i As Long
Dim num As Long

Worksheets("Estimates").ListBox1.Clear
Set xcell = Sheets("Database Links").Range("estlnkdb")
Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
est = Sheets("Estimates DB").Range("currentestimate")
With rng
Set fcell = .Find(what:=est, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With
num = fcell.Offset(0, 1)
ReDim a(num)
For i = 1 To num
a(i) = fcell.Offset(i, 0)
Next
With Sheets("Estimates")
For i = 1 To num
With .ListBox1
.AddItem a(i)
End With
Next
End With

End Sub

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Sub startautocalc()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Again if someone can help me with this. I've tried everything I can think of.
Thank You
Click to expand...
 
R

ranswrt

I tried
With Sheets("database links")
Set rng = .Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
End With
I don't know if that is the proper way to reference a worksheet, but that
didn't work either. The first line of code in loadlistbox doesn't work
either. Loadlistbox does work when it is run by itself or when other
procedures call it it. Any other suggestions

Joel said:
I suspect this range statement needs a reference to a worksheet

Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))

ranswrt said:
If anyone can help me with this it would be greatly appreciated.

I have the following procedure that works good except for the end on call
loadlistbox. The value in the listbox doesn't change. I have the codes for
loadlistbox, stopautocalc, and startautocalc at the end of this post.
Loadlistbox does work when ran independently and when it is called from other
procedures

Sub previousestimate()
Dim fcell As Range
Dim code As String
Dim i As Integer
Dim xcell As Range
Dim ycell As Range
Dim a() As Variant
Dim chk As Excel.CheckBox
Dim cnt As Integer
Dim x As Integer
Dim j As Integer
Dim z As String
Dim rng As Range
Dim subcat As String
Dim est As String
Dim cst As String



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



est = Sheets("Estimates DB").Range("currentestimate")
cst = Replace(est, "est", "cst")
estnum = Sheets("Estimates DB").Range("estimatenumber")
num = Sheets("Estimates").Range("estnum")

If cst = "cst01" Then
MsgBox ("This is the First Cost Item Estimate Sheet.")
Else
If num > 0 Then

Set xcell = Sheets("Estimates").Range("estlinkno")
For i = 1 To num
lnknum = xcell.Offset(i, 0)
ActiveSheet.Checkboxes("Checkbox" & est & lnknum).Delete
Next
Set xcell = Sheets("Estimates").Range("estno")
Range(xcell.Offset(1, 0), xcell.Offset(num, 6)).ClearContents
Sheets("Estimates").Range("estitemsrng").Locked = True
If num > 10 Then
Range(xcell.Offset(11, 0), xcell.Offset(num, 0)).EntireRow.Delete
With Range(xcell.Offset(10, 0), xcell.Offset(10,
5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Sheets("Estimates").Range("estnum") = 0
End If

Set rng = Sheets("Cost Items DB").Range("costitemidrng")
With rng
Set fcell = .Find(what:=cst, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With

cst = fcell.Offset(-1, 0)
est = Replace(cst, "cst", "est")
Sheets("Estimates DB").Range("currentestimate") = est
code = fcell.Offset(-1, -2)
costitem = fcell.Offset(-1, -1)
subcat = fcell.Offset(-1, 6)
Sheets("Estimates").Range("estcode") = code
Sheets("Estimates").Range("estitem") = costitem
Sheets("Estimates").Range("estsubcat") = "Sub Category of: " & subcat
If fcell.Offset(-1, 7) Then
Worksheets("Estimates").CheckBox1.Value = True
Else
Worksheets("Estimates").CheckBox1.Value = False
End If

If estnum > 0 Then
Set rng = Sheets("Estimates DB").Range("estdbidrng")
cnt = Application.WorksheetFunction.CountIf(rng, est)
ReDim a(cnt, 7)

If cnt > 10 Then
Set xcell = Sheets("Estimates").Range("estno")
For i = 10 To (cnt - 1)
xcell.Offset((i), 0).EntireRow.Insert
Next
End If

Set xcell = Sheets("Estimates DB").Range("estdbid")
num = 0
For i = 1 To estnum
If xcell.Offset(i, 0) = est Then
num = num + 1
Set fcell = xcell.Offset(i, 0)
a(num, 1) = fcell.Offset(0, 2)
a(num, 2) = fcell.Offset(0, 3)
a(num, 3) = fcell.Offset(0, 4)
a(num, 4) = fcell.Offset(0, 5)
a(num, 5) = fcell.Offset(0, 6)
a(num, 6) = fcell.Offset(0, 6).address
a(num, 7) = fcell.Offset(0, 6).address(ReferenceStyle:=xlR1C1)
End If
Next
For i = 1 To cnt
Set ycell = Sheets("Estimates").Range("estno")
ycell.Offset(i, 0) = i
ycell.Offset(i, 2) = a(i, 1)
ycell.Offset(i, 3) = a(i, 2)
ycell.Offset(i, 4) = a(i, 3)
ycell.Offset(i, 6) = a(i, 4)
lnknum = a(i, 4)
Set ycell = Sheets("Estimates").Range("estno").Offset(i, 1)
Set chk = ycell.Parent.Checkboxes.Add(ycell.Left, ycell.Top, 0,
ycell.Height)
chk.Height = ycell.Height - 1.5
chk.Characters.Text = ""
chk.Name = "Checkbox" & est & lnknum
z = a(i, 6)
z = "'Estimates DB'!" & z
chk.LinkedCell = z
chk.Visible = True
chk.Display3DShading = True
chk.OnAction = "updateestimatetotal"
If a(i, 5) Then
chk.Value = True
Else
chk.Value = False
End If
Set ycell = Sheets("estimates").Range("esttotal")
ycell.Offset(i, 0).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
ycell.Offset(i, 0).FormulaR1C1 = "=if('Estimates DB'!" & a(i, 7)
& ",RC[-1],0)"
Set ycell = Sheets("Estimates").Range("estno")
Range(ycell.Offset(i, 2), ycell.Offset(i, 4)).Locked = False
Next
Else
num = 0
End If

End If
Sheets("Estimates").Range("estnum") = num
Call nameestranges
Sheets("Estimates").Range("estno").Offset(num, 2).Select
addborders

Worksheets("Estimates").Protect Password:="6573"
Worksheets("Estimates DB").Protect Password:="6573"
Call startautocalc

Call loadlistbox

End Sub



I found that if I change this code at the beggining of the previousestimate
procedure from this



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



to this



Worksheets("Estimates db").Unprotect Password:="6573"
Call stopautocalc
Worksheets("Estimates").Unprotect Password:="6573"



the loadlistbox procedure that is called at the end works. The only problem
is that the screen flashes on the unprotect sheets at the beginning of the
code.

Sub loadlistbox()
Dim est As String
Dim xcell As Range
Dim fcell As Range
Dim rng As Range
Dim a() As String
Dim i As Long
Dim num As Long

Worksheets("Estimates").ListBox1.Clear
Set xcell = Sheets("Database Links").Range("estlnkdb")
Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
est = Sheets("Estimates DB").Range("currentestimate")
With rng
Set fcell = .Find(what:=est, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With
num = fcell.Offset(0, 1)
ReDim a(num)
For i = 1 To num
a(i) = fcell.Offset(i, 0)
Next
With Sheets("Estimates")
For i = 1 To num
With .ListBox1
.AddItem a(i)
End With
Next
End With

End Sub

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Sub startautocalc()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Again if someone can help me with this. I've tried everything I can think of.
Thank You
Click to expand...
Click to expand...
 
J

Joel

The best way of finding the problem is for you to debug the problem and
isolate where the problem is. There are too many reason why the code will
fail including Named Range being wrong, Incorrect cells being referenced,
wrong data in cells. Use the following techniques to isolate the problem:

1) Put break points in code using F9
2) Step through code using F8
3) run until next break point F5.
4) Look at each variable value by
a) Move mouse over variable to find value
b) Add Watch for variables by highlghting variable and then right
click mouse. select "Add to Watch"
c) Add debug print statements. Go to menu View - Immediate Window to
see debug statements like debug print a Where a is a variable in your
code.

ranswrt said:
I tried
With Sheets("database links")
Set rng = .Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
End With
I don't know if that is the proper way to reference a worksheet, but that
didn't work either. The first line of code in loadlistbox doesn't work
either. Loadlistbox does work when it is run by itself or when other
procedures call it it. Any other suggestions

Joel said:
I suspect this range statement needs a reference to a worksheet

Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))

ranswrt said:
If anyone can help me with this it would be greatly appreciated.

I have the following procedure that works good except for the end on call
loadlistbox. The value in the listbox doesn't change. I have the codes for
loadlistbox, stopautocalc, and startautocalc at the end of this post.
Loadlistbox does work when ran independently and when it is called from other
procedures

Sub previousestimate()
Dim fcell As Range
Dim code As String
Dim i As Integer
Dim xcell As Range
Dim ycell As Range
Dim a() As Variant
Dim chk As Excel.CheckBox
Dim cnt As Integer
Dim x As Integer
Dim j As Integer
Dim z As String
Dim rng As Range
Dim subcat As String
Dim est As String
Dim cst As String



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



est = Sheets("Estimates DB").Range("currentestimate")
cst = Replace(est, "est", "cst")
estnum = Sheets("Estimates DB").Range("estimatenumber")
num = Sheets("Estimates").Range("estnum")

If cst = "cst01" Then
MsgBox ("This is the First Cost Item Estimate Sheet.")
Else
If num > 0 Then

Set xcell = Sheets("Estimates").Range("estlinkno")
For i = 1 To num
lnknum = xcell.Offset(i, 0)
ActiveSheet.Checkboxes("Checkbox" & est & lnknum).Delete
Next
Set xcell = Sheets("Estimates").Range("estno")
Range(xcell.Offset(1, 0), xcell.Offset(num, 6)).ClearContents
Sheets("Estimates").Range("estitemsrng").Locked = True
If num > 10 Then
Range(xcell.Offset(11, 0), xcell.Offset(num, 0)).EntireRow.Delete
With Range(xcell.Offset(10, 0), xcell.Offset(10,
5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Sheets("Estimates").Range("estnum") = 0
End If

Set rng = Sheets("Cost Items DB").Range("costitemidrng")
With rng
Set fcell = .Find(what:=cst, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With

cst = fcell.Offset(-1, 0)
est = Replace(cst, "cst", "est")
Sheets("Estimates DB").Range("currentestimate") = est
code = fcell.Offset(-1, -2)
costitem = fcell.Offset(-1, -1)
subcat = fcell.Offset(-1, 6)
Sheets("Estimates").Range("estcode") = code
Sheets("Estimates").Range("estitem") = costitem
Sheets("Estimates").Range("estsubcat") = "Sub Category of: " & subcat
If fcell.Offset(-1, 7) Then
Worksheets("Estimates").CheckBox1.Value = True
Else
Worksheets("Estimates").CheckBox1.Value = False
End If

If estnum > 0 Then
Set rng = Sheets("Estimates DB").Range("estdbidrng")
cnt = Application.WorksheetFunction.CountIf(rng, est)
ReDim a(cnt, 7)

If cnt > 10 Then
Set xcell = Sheets("Estimates").Range("estno")
For i = 10 To (cnt - 1)
xcell.Offset((i), 0).EntireRow.Insert
Next
End If

Set xcell = Sheets("Estimates DB").Range("estdbid")
num = 0
For i = 1 To estnum
If xcell.Offset(i, 0) = est Then
num = num + 1
Set fcell = xcell.Offset(i, 0)
a(num, 1) = fcell.Offset(0, 2)
a(num, 2) = fcell.Offset(0, 3)
a(num, 3) = fcell.Offset(0, 4)
a(num, 4) = fcell.Offset(0, 5)
a(num, 5) = fcell.Offset(0, 6)
a(num, 6) = fcell.Offset(0, 6).address
a(num, 7) = fcell.Offset(0, 6).address(ReferenceStyle:=xlR1C1)
End If
Next
For i = 1 To cnt
Set ycell = Sheets("Estimates").Range("estno")
ycell.Offset(i, 0) = i
ycell.Offset(i, 2) = a(i, 1)
ycell.Offset(i, 3) = a(i, 2)
ycell.Offset(i, 4) = a(i, 3)
ycell.Offset(i, 6) = a(i, 4)
lnknum = a(i, 4)
Set ycell = Sheets("Estimates").Range("estno").Offset(i, 1)
Set chk = ycell.Parent.Checkboxes.Add(ycell.Left, ycell.Top, 0,
ycell.Height)
chk.Height = ycell.Height - 1.5
chk.Characters.Text = ""
chk.Name = "Checkbox" & est & lnknum
z = a(i, 6)
z = "'Estimates DB'!" & z
chk.LinkedCell = z
chk.Visible = True
chk.Display3DShading = True
chk.OnAction = "updateestimatetotal"
If a(i, 5) Then
chk.Value = True
Else
chk.Value = False
End If
Set ycell = Sheets("estimates").Range("esttotal")
ycell.Offset(i, 0).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
ycell.Offset(i, 0).FormulaR1C1 = "=if('Estimates DB'!" & a(i, 7)
& ",RC[-1],0)"
Set ycell = Sheets("Estimates").Range("estno")
Range(ycell.Offset(i, 2), ycell.Offset(i, 4)).Locked = False
Next
Else
num = 0
End If

End If
Sheets("Estimates").Range("estnum") = num
Call nameestranges
Sheets("Estimates").Range("estno").Offset(num, 2).Select
addborders

Worksheets("Estimates").Protect Password:="6573"
Worksheets("Estimates DB").Protect Password:="6573"
Call startautocalc

Call loadlistbox

End Sub



I found that if I change this code at the beggining of the previousestimate
procedure from this



Call stopautocalc
Worksheets("Estimates db").Unprotect Password:="6573"
Worksheets("Estimates").Unprotect Password:="6573"



to this



Worksheets("Estimates db").Unprotect Password:="6573"
Call stopautocalc
Worksheets("Estimates").Unprotect Password:="6573"



the loadlistbox procedure that is called at the end works. The only problem
is that the screen flashes on the unprotect sheets at the beginning of the
code.

Sub loadlistbox()
Dim est As String
Dim xcell As Range
Dim fcell As Range
Dim rng As Range
Dim a() As String
Dim i As Long
Dim num As Long

Worksheets("Estimates").ListBox1.Clear
Set xcell = Sheets("Database Links").Range("estlnkdb")
Set rng = Range(xcell.Offset(0, 1), xcell.Offset(0, 130))
est = Sheets("Estimates DB").Range("currentestimate")
With rng
Set fcell = .Find(what:=est, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns)
End With
num = fcell.Offset(0, 1)
ReDim a(num)
For i = 1 To num
a(i) = fcell.Offset(i, 0)
Next
With Sheets("Estimates")
For i = 1 To num
With .ListBox1
.AddItem a(i)
End With
Next
End With

End Sub

Sub stopautocalc()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Sub startautocalc()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Again if someone can help me with this. I've tried everything I can think of.
Thank You
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Listbox problems 3
I need help again 4
Can't get this to work 6
Formulas 4
Screen Flashing 6
insert formula 2
combobox after change but user hits cancel to message box 5
VBA for Dependents shortcut menu 0

Top