Problem with Code --- Please help

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

*** Sent via Developersdex http://www.developersdex.com ***

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

--
Cheers
Nigel



"Les Stout" <[email protected]> wrote in message
news:[email protected]...
> 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
>
> *** Sent via Developersdex http://www.developersdex.com ***

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

*** Sent via Developersdex http://www.developersdex.com ***

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

--
Regards,
Tom Ogilvy


"Les Stout" <[email protected]> wrote in message
news:[email protected]...
> 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
>
> *** Sent via Developersdex http://www.developersdex.com ***

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

Thanks again for your help.

best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

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

*** Sent via Developersdex http://www.developersdex.com ***

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


--
Regards,
Tom Ogilvy


"Les Stout" <[email protected]> wrote in message
news:e%23Mh%[email protected]...
> 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
>
> *** Sent via Developersdex http://www.developersdex.com ***

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

*** Sent via Developersdex http://www.developersdex.com ***

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.

--
Regards,
Tom Ogilvy


"Les Stout" <[email protected]> wrote in message
news:uVVXj%[email protected]...
> 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
>
> *** Sent via Developersdex http://www.developersdex.com ***

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


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

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

--
Regards,
Tom Ogilvy


"Les Stout" <[email protected]> wrote in message
news:[email protected]...
> Hi Tom, if i leave out the Insert "ProcRoutine" it works fine ? ( All of
> the last code i gave)
>
>
> Les Stout
>
> *** Sent via Developersdex http://www.developersdex.com ***

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

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***