Problem with Code --- Please help

[Les Stout]

Hi, i got this code very kindly from Tom and i have changed it, but it
does not work. Could you please help me ?

Sub TotalsS()
'
Dim eRowS As Long
Dim fRowS As Long
Dim LrowS As Long
Dim myValS As Long
eRowS = Cells(Rows.Count, 1).End(xlUp).Row
fRowS = 4
Do Until LrowS = eRowS + 1
LrowS = Cells(fRowS, 10).End(xlDown).Row + 1
With Cells(LrowS, 10)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.NumberFormat = "R #,##0.00"
.FormulaR1C1 = _
"=SUM(R[-" & LrowS - fRowS & "]C:R[-1]C)"
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
End With
fRowS = LrowS + 2
Loop
myValS = Cells(LrowS, 10)
With Cells(LrowS, 10)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, Formula1:="0"
.FormatConditions(1).Interior.ColorIndex = 35
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlLess, Formula1:="0"
.FormatConditions(2).Interior.ColorIndex = 38
End With
If myValS < 0 Then Cells(LrowS, 7) = "Total due to supplier"
'--Minus value
If myValS > 0 Then Cells(LrowS, 7) = "Total due to BMW SA" '
--Positive value
With Cells(LrowS, 7)
.Font.Bold = True
End With
Columns("J:J").ColumnWidth = 12
Range("C4").Select
ActiveWindow.FreezePanes = True
GetSuppNameAS
End Sub


Les Stout

 

[Nigel]

Um? What does not work? What errors do you get and what is it trying to do
?

 

[Les Stout]

Ooops...... sorry, forgot that part !!! It is almost like it is looping
as i get two totals at the bottom and i am supposed to only have one
total. I then get an error at what looks like the third loop of "out of
range" at this point: With Cells(LrowS, 10)


Les Stout

 

[Tom Ogilvy]

This puts in a single total at the bottom of a column of numbers starting in
Row 4 of column 10

by the way, you said "Tom" gave you this code, but it must be a different
"Tom" than me. I only mention that because you contacted me asking for
help.

Sub TotalsS()
'
Dim eRowS As Long
Dim fRowS As Long
Dim LrowS As Long
Dim myValS As Long
eRowS = Cells(Rows.Count, 1).End(xlUp).Row
fRowS = 4
LrowS = Cells(fRowS, 10).End(xlDown).Row + 1
With Cells(LrowS, 10)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.NumberFormat = "R #,##0.00"
.FormulaR1C1 = _
"=SUM(R[-" & LrowS - fRowS & "]C:R[-1]C)"
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
End With
fRowS = LrowS + 2
myValS = Cells(LrowS, 10)
With Cells(LrowS, 10)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:="0"
.FormatConditions(1).Interior.ColorIndex = 35
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlLess, Formula1:="0"
.FormatConditions(2).Interior.ColorIndex = 38
End With
If myValS < 0 Then Cells(LrowS, 7) = _
"Total due to supplier" '--Minus value
If myValS > 0 Then Cells(LrowS, 7) = _
"Total due to BMW SA" '--Positive value
With Cells(LrowS, 7)
.Font.Bold = True
End With
Columns("J:J").ColumnWidth = 12
Range("C4").Select
ActiveWindow.FreezePanes = True
GetSuppNameAS
End Sub

 

[Les Stout]

Thanks for your help Tom, i thought it was you.

Thanks again for your help.

best regards,

Les Stout

 

[Les Stout]

Hi Tom, i still have a problem and i cannot figure out what it is ? If i
run this code manually using "F8" to step into and then "F5" it works
great, but if i run it whith the rest of my code it inserts two totals,
one at the botom of the column and then another after it ??

Any suggestions ?

Les Stout

 

[Tom Ogilvy]

That would mean your other code is running it more than once.

You have to figure out why. Adding a msgbox will show you when it gets
called. Perhaps that will help.

Sub TotalsS()
'
Dim eRowS As Long
Dim fRowS As Long
Dim LrowS As Long
Dim myValS As Long

msgbox "In TotalsS"

eRowS = Cells(Rows.Count, 1).End(xlUp).Row
fRowS = 4
LrowS = Cells(fRowS, 10).End(xlDown).Row + 1
With Cells(LrowS, 10)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.NumberFormat = "R #,##0.00"
.FormulaR1C1 = _
"=SUM(R[-" & LrowS - fRowS & "]C:R[-1]C)"
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
End With
fRowS = LrowS + 2
myValS = Cells(LrowS, 10)
With Cells(LrowS, 10)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:="0"
.FormatConditions(1).Interior.ColorIndex = 35
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlLess, Formula1:="0"
.FormatConditions(2).Interior.ColorIndex = 38
End With
If myValS < 0 Then Cells(LrowS, 7) = _
"Total due to supplier" '--Minus value
If myValS > 0 Then Cells(LrowS, 7) = _
"Total due to BMW SA" '--Positive value
With Cells(LrowS, 7)
.Font.Bold = True
End With
Columns("J:J").ColumnWidth = 12
Range("C4").Select
ActiveWindow.FreezePanes = True
GetSuppNameAS
End Sub

 

[Les Stout]

Hi Tom, yes the addition of the msgbox does show that it is looping
again.
It would appear that the code below is the problem, but i do not know
how.

Sub BBBS()
InsertProc
Application.OnTime Now, "BBB_2S"
End Sub

Sub BBB_2S()
Application.EnableEvents = False
Columns("H:H").Locked = False ' ---This line
ActiveSheet.Protect Password:="secret", Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = True
SaveFileS
End Sub
Sub InsertProc()
Dim sname As String
Dim StartLine As Long
sname = ActiveSheet.CodeName
With ActiveWorkbook.VBProject.VBComponents(sname).CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, _
"Dim VRange As Range"
.InsertLines StartLine + 1, _
"Set VRange =ActiveSheet.Columns(""H:H"")"
.InsertLines StartLine + 2, _
"Me.Protect UserInterfaceOnly:=True," & _
" Password:=""secret"""
.InsertLines StartLine + 3, _
"Target.Font.ColorIndex = 3"
.InsertLines StartLine + 4, _
"Target.Font.Bold = True"
End With
End Sub

Best Regards,

Les Stout

 

[Tom Ogilvy]

I don't see anything in that code that would cause TotalsS to run.

Columns("H:H").Locked = False ' ---This line

I don't know of any way that line would trigger code to run.

the last line of your TotalsS routine calls another procedure:
GetSuppNameAS

there is a place to look as well.

 

[Les Stout]

Hi Tom, if i leave out the Insert "ProcRoutine" it works fine ? ( All of
the last code i gave)


Les Stout

 

[Tom Ogilvy]

I know, you told me that. I don't see any linkage.

 

[Les Stout]

Ok thanks for the help , i'm off home...

Les Stout