Looping Problem

[Spasm]

hi...

i use the following code to update some files.

 Sub Macro4update()
      Cells(2, 1).Select
    Do While IsEmpty(ActiveCell.Offset(0, 0)) = False
      Range(ActiveCell, ActiveCell.Offset(0, 7)).Select
     Selection.Copy
    Workbooks.Open Filename:=Range(ActiveCell, ActiveCell.Offset(0, 0)).Value
    On Error GoTo ErrHandler:
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    ActiveWindow.Close
Label1:
    ActiveCell.Offset(1, 0).Select
       Loop
ErrHandler:
      Resume Label1
End Sub

When it reaches the last row, it keeps on looping.
i want it to stop after the last row is done......

Please help...

Thanks





Additional details:-

the cell values in the first column are the names of the files stored on my hard disk,
if a file is not present on my hard disk for upgradation, it will give error...
hence i m forced on using the error handler,
but its messing up the loop.

Plz help

[Leith Ross]

Hello Spasm,

Here is your macro with a few revisions.

 Sub Macro4update()
 
   Dim Cell As Range
   Dim R As Long
   
     Set Cell = Cells(2, "A")
   
     While Not IsEmpty(Cell.Offset(R, 0))
       If Dir(Cell) <> "" Then
          Cell.Resize(1, 8).Copy
          Workbooks.Open Filename:=Cell.Value
            ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
          ActiveWorkbook.Close SaveChanges:=True
          R = R + 1
       End If
     Wend
   
End Sub

[Spasm]

hi....
thank u for helping me with the code
but it gives an error at

END IF

( 3rd line from bottom )

[Mordred]

Does the following work?

Sub Macro4update()
      Cells(2, 1).Select
      Do While IsEmpty(Cells(2, 1)) = False
        Set rng1 = Range(Cells(2, 1), Cells(2, 1).Offset(0, 7))
        On Error Resume Next
        Workbooks.Open Filename:=Cells(2, 1).Value
        Set rng2 = Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 7))
        rng2.Cells.Value = rng1.Cells.Value
        ActiveWorkbook.Save
        ActiveWindow.Close
      Loop
End Sub

This was not tested except for at compile time. I really don't know if it will do what you want at run-time. I was just playing with your code.

[Spasm]

thank U for ur effort
but the code has some problems
i tried it....
it keeps on looping on the 2nd row... it does not increment,, and it also keeps on prompting to save the file...

[Mordred]

Maybe:

Option Explicit
Sub Macro4update()
    Dim Rng1 As Range, Rng2 As Range
    Dim RwCnt As Long, x As Long
    RwCnt = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
      For x = 2 To RwCnt
      If IsEmpty(Cells(x, 1)) = False Then
        Set Rng1 = Range(Cells(x, 1), Cells(x, 1).Offset(0, 7))
        On Error Resume Next
        Workbooks.Open Filename:=Cells(x, 1).Value
        Set Rng2 = Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 7))
        Rng2.Cells.Value = Rng1.Cells.Value
        ActiveWorkbook.Save
        ActiveWindow.Close
      End If
      Next x
End Sub

[Leith Ross]

Hello Spasm,

Sorry, I forgot to exit when the cell is empty. Try this instead...

 Sub Macro4update()
 
   Dim Cell As Range
   Dim R As Long
   
     Set Cell = Cells(2, "A")
   
     While Not IsEmpty(Cell.Offset(R, 0))
       If Dir(Cell) <> "" Then
          Cell.Resize(1, 8).Copy
          Workbooks.Open Filename:=Cell.Value
            ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
          ActiveWorkbook.Close SaveChanges:=True
          R = R + 1
       Else
          Exit Sub
       End If
     Wend
   
End Sub

[Spasm]

hi Leith Ross
i tried the second code
but it didnt run at all


thank u for ur effort n time

[Leith Ross]

Hello Spasm,

I can not help you further on this problem because I have no idea what you are doing on your end that is causing the code to fail. The code works on my machine and I am running Excel 2003 under Windows XP. Perhaps, you will figure it out in time.

[Spasm]

thanks ......

[Spasm]

thanks

[Spasm]

hi Mordred
i tried ur second code
it increments but always prompts to save the file
and when an error occurs,,, it stops incrementing and auto closes itself

thanks for ur effort

[Spasm]

its ok


i m sorry for not providing enough information about my problem

thanks for your time and effort

[royUK]

This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

Thread Closed.

[Marcol]

Hmm?
We seem to be in a bit of a mess here!

Is this thread closed or not?
The duplicate certainly is and that's where I posted a solution that works for me!

[Spasm]

ok
thanks

[Spasm]

2 files for my code problem

[Spasm]

ur code did everything perfectly as i wanted
but once the last row was done
it kept on looping until row 65536

[shg]

At a glance, you need an Exit Sub statement after the Loop statement.

[Spasm]

yesssssssssss yaaaaaayyyy,,
i added EXIT SUB after the loop, and the macro worked perfectly fine.. did everything perfectly and didnt kept on looping after the last row

thank U Mordred
&
thank u SHG

for your amazing help and for giving ur precious time to solve my problem

thank u ALL

[Mordred]

I added one line of code to your existing code from post 1, will it work? Maybe.

 Sub Macro4update()
      Cells(2, 1).Select
    Do While IsEmpty(ActiveCell.Offset(0, 0)) = False
      Range(ActiveCell, ActiveCell.Offset(0, 7)).Select
     Selection.Copy
    Workbooks.Open Filename:=Range(ActiveCell, ActiveCell.Offset(0, 0)).Value
    On Error GoTo ErrHandler:
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    ActiveWindow.Close
Label1:
    ActiveCell.Offset(1, 0).Select
    If ActiveCell.Value = "" Then Exit Do
       Loop
ErrHandler:
      Resume Label1
End Sub

I added

If ActiveCell.Value = "" Then Exit Do

[Mordred]

Have you tried the code that I provided in post #18? shg is no doubt right so maybe instead of

Exit Do

you should have

Exit Sub

[Mordred]

It could be

Label1:
    ActiveCell.Offset(1, 0).Select
    If ActiveCell.Value = "" Then Exit Do
       Loop
ErrHandler:
      Resume Label1

that is causing the most problems, specifically

Resume Label1

which puts you right back into the loop.

[Mordred]

We are glad to help. If you feel that your problem has been solved, mark this thread as solved and, if you are happy with the help you have received, don't be shy and tap the scales of those that helped.

Cheers

[Spasm]

yes .... added reputation for both of u

[Marcol]

The solution I offered in your closed duplicate thread works, and solves other problems that might arrise.

You PMd me to say it doesn't work, I can't see why this should be the case, but if your happy, so am I.

[Spasm]

no no.... plz dont take me wrong, ur code has to b precise
i appreciate what u did for me

it was my fault
i hadnt mentioned precisely what i wanted to do with the code