Counter stops working

[ajm1949]

I have been using the following code to add items from one worksheet to
another in a specific row and column. I have used this code for a few years.
Recently when editing in Excel 2007 (compatability mode) the counter stops
working. ie it always puts the data in row 7 instead of counting down one row
for each additional item.Does any one have any ideas on what has changed or
is there a better way to control where the copied data is placed.

Sub FordRetail()
'<<RETAIL
On Error Resume Next
Dim WkSht As Worksheet
Dim Counter As Long
Dim RowCount As Long
Dim i As Object, Y As Object

Set WkSht = Sheets("Calculator")

r$ = Trim(Str(ActiveCell.Row))
Counter = 7
Do While Not Range("Ford2007.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop
'<< <your code to initialize counter>

For Each i In Selection.Areas
RowCount = RowCount + i.Rows.Count
Next i

'<<If Counter <=18Then '<< Maybe S/B Counter
If RowCount <= 26 Then '<<??????
For Each Y In Selection
WkSht.Cells(Counter, 1).Value = Cells(Y.Row, 2).Value
'<<Cells(Row,Column) B;A Vehicle
WkSht.Cells(Counter, 4).Value = Cells(Y.Row, 1).Value '<<Code
WkSht.Cells(Counter, 2).Value = _
Cells(Y.Row, 3).Value + Cells(Y.Row, 4).Value + Cells(Y.Row,
5).Value '<<RRP No LCT

WkSht.Cells(Counter, 12).Value = _
Cells(Y.Row, 3).Value + Cells(Y.Row, 4).Value + Cells(Y.Row,
5).Value '<<RRP No LCT

WkSht.Cells(Counter, 7).Value = Cells(Y.Row, 5).Value '<<MARGIN

Counter = Counter + 1
Next Y

Else
MsgBox "Too Many Items", vbExclamation, "Quotemaster"
End If

End Sub

Cheers

Alan

 

[OssieMac]

Hi Alan,

Untested but the following code does not look correct.
Counter = 7
Do While Not Range("Ford2007.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop

Try the following by assigning the workbook to a variable and then assigning
the worksheet to a variable.

Counter = 7

Dim wb As Workbook 'insert with other Dim's
Dim ws As Worksheet 'insert with other Dim's

Set wb = Workbooks("Ford2007.xls")
'Edit "Sheet1" to the required sheet name
Set ws = wb.Sheets("Sheet1")
With ws
Do While .Cells(Counter, "A") <> ""
Counter = Counter + 1
Loop
End With

 

[Ryan H]

This should fix the issue you are having. You don't have to loop through
cells to find the last cell with data in it. Just replace this loop

Counter = 7
Do While Not Range("Ford2007.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop

with this line of code

Counter =
Workbooks("Ford2007.xls").Sheets("Sheet1").Range("A7").End(xlDown).Row

You will have to change the name of the worksheet from "Sheet1" to whatever
sheet pretains to the Counter variable. Note, Workbook Ford2007.xls will
have to be open for this code to work properly.


You actually have a few things wrong with the code and I have a few
recommendations to make as well. I also took the liberty of re-writing your
code to make it more efficient.

1.) I would highly recommend not using On Error Resume Next statement. You
are only inviting trouble by doing this. If an error occurs you will never
know about it thus you may not recognize issues like the issue you are having
now.

2.) You don't seem to use the variable r in this Sub, nor have you declared
the variable r. Is this Sub called by another Sub? If not, just remove this
line of code

r$ = Trim(Str(ActiveCell.Row))

If you do use the variable r in another Sub make sure the variable is
declared as a Long data type and use this line of code

Dim r As Long
r = ActiveCell.Row

3.) When referencing a worksheet several times use the With...End With
statement.

4.) Give this code a try and let me know if this helps! If so, let me
know, click "YES" below.

Sub FordRetail()

Dim Counter As Long
Dim RowCount As Long
Dim Area As Object
Dim Y As Object

Counter =
Workbooks("Ford2007.xls").Sheets("Sheet1").Range("A7").End(xlDown).Row

For Each Area In Selection.Areas
RowCount = RowCount + Area.Rows.Count
Next Area

If RowCount <= 26 Then
For Each Y In Selection
With Sheets("Calculator")
.Cells(Counter, "A").Value = Cells(Y.Row, "B").Value
'<<Cells(Row,Column) B;A Vehicle
.Cells(Counter, "D").Value = Cells(Y.Row, "A").Value
'<<Code
.Cells(Counter, "B").Value = Cells(Y.Row, "C").Value + _
Cells(Y.Row, "D").Value + _
Cells(Y.Row, "E").Value
'<<RRP No LCT

.Cells(Counter, "L").Value = Cells(Y.Row, "C").Value + _
Cells(Y.Row, "D").Value + _
Cells(Y.Row, "E").Value
'<<RRP No LCT

.Cells(Counter, "G").Value = Cells(Y.Row, "E").Value
'<<MARGIN
End With
Counter = Counter + 1
Next Y
Else
MsgBox "Too Many Items", vbExclamation, "Quotemaster"
End If

End Sub

 

[Ryan H]

You could just replace the entire loop with this line of code, right?

Counter =
Workbooks("Ford2007.xls").Sheets("Sheet1").Range("A7").End(xlDown).Row

 

[ajm1949]

Hello Ryan

Thanks very much for your input particularly your ideas to streamline the
code.
I am having a problem with your suggested code for the counter.
I am not sure what you meant by the sheet that pretains the counter value.
is this the Calculator Sheet as this is the one where we put the data?
What we want to achieve is to put the first item on the Calculator worksheet
(partially protected ws) in row 7 after checking that cell A7 is empty ands
so on to row 26.

My version of the code has been fine but recently when editting in Excel
2007 compatability mode with macros disabled it stopped working when macros
were enabled again. Editting with macros enabled does not seem to cause the
problem. I simply comment out some of the worksheet activate code to make it
easier to edit as the various worksheets are protected by some code that also
highlights the selected row(s)

regards

Alan