Ending a loop

[Mortadella]

I am trying to write a Do Until loop and everything works alright except when it gets to "B1" it keeps running and then the loop destroys all the work.

I am trying to figure out two things:
1: When does the Do test actually happen?
2: How do I end the loop if my current test isn't working?

Do Until ActiveCell.Value = "B1"
Selection.End(xlUp).Select
If ActiveCell.Address = ("B1") Then
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Activate
ActiveCell.FormulaR1C1 = "***"
Selection.End(xlUp).Select
Selection.Copy
ActiveCell.End(xlDown).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Loop

 

[Luke M]

First, I don't think the above will even work, as the If statement does not have an End If statement.

Next, does the cell value ever equal B1, or did you mean to check the address?
If your code gets stuck in a loop, hit Ctrl+Alt+Break (usually on the Pause key). That will give you this message

and you can then decide what to do.

Finally, I see a lot of selecting going on in your code, which usually is not needed and slows things down. What is the overall goal of your code?

 

[Mike H..]

I am trying to write a Do Until loop and everything works alright except when it gets to "B1" it keeps running and then the loop destroys all the work.

I am trying to figure out two things:
1: When does the Do test actually happen?
2: How do I end the loop if my current test isn't working?

Do Until ActiveCell.Value = "B1"
Selection.End(xlUp).Select
If ActiveCell.Address = ("B1") Then
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Activate
ActiveCell.FormulaR1C1 = "***"
Selection.End(xlUp).Select
Selection.Copy
ActiveCell.End(xlDown).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Loop

Hi,

There are errors in this code you posted so it's difficult to follow what you're doing. Perhaps you could explain in words what the objective is then someone will help.

A do loop will terminate on the line where the termination condition is satisfied and in this code it's here

Do Until ActiveCell.Value = "B1"

So when this line executes if the text in the activecell is B1 then execution ends.

 

[Mortadella]

Thank you for your help. I rewrote the macro and it now does what I want. I now want to take that information and extract the sales for each individual and paste them into each ones sheet.
I have written the following attempt to do that but I'm running into an End If error. I have a number of If statements and you'll see below how I have set it up. Do I need an End If after each line? (Please forgive me if the coding seems crude - I'm no expert and I'm just trying to make it work.)

I'd like to attach the spreadsheet but I am concerned about the confidentiality of the information. If I need to change the names I can do it but it will take a lot pf work. Please let me know what your policy is on this please.

Anyway the macro is written like this:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("R7").Select
    Selection.End(xlDown).Select
    ActiveCell.Select
    If Cell.Value = "707" Then
    If Cell.Value = "709" Then
    If Cell.Value = "711" Then
    If Cell.Value = "712" Then
    If Cell.Value = "713" Then
    If Cell.Value = "718" Then
    If Cell.Value = "725" Then
    If Cell.Value = "733" Then
    If Cell.Value = "734" Then
    If Cell.Value = "735" Then
    If Cell.Value = "738" Then
    If Cell.Value = "739" Then
    End If
    ActiveCell.Offset(0, -15).Select
    Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
    If Cell.Value = "707" Then Sheets(4).Select
    If Cell.Value = "709" Then Sheets(13).Select
    If Cell.Value = "711" Then Sheets(5).Select
    If Cell.Value = "712" Then Sheets(6).Select
    If Cell.Value = "713" Then Sheets(7).Select
    If Cell.Value = "718" Then Sheets(8).Select
    If Cell.Value = "725" Then Sheets(14).Select
    If Cell.Value = "733" Then Sheets(9).Select
    If Cell.Value = "734" Then Sheets(16).Select
    If Cell.Value = "735" Then Sheets(17).Select
    If Cell.Value = "738" Then Sheets(18).Select
    If Cell.Value = "739" Then Sheets(20).Select
    ActiveSheet.Range("C65536").End(xlUp).Select
    ActiveSheet.Paste
    End If
  
End Sub

 

[Smallman]

Hi Mortdella

This should do what you are after but it is better to show a workbook. I can't understand why your numbers "707", "709" etc. are text. Showing a file tells the story. Also to change names just name the data Person1 and drag down - protects the innocent that way.

Option Explicit
 
Sub CopytoSh() 'Copy Col C to new sheet.
Dim var As Variant
Dim ar As Variant
Dim i As Integer
'Store the values in an array or two
ar = [{4,5,6,7,8,9,13,14,15,16,17,18,20}] 'Sheets
var = [{"707", "709", "711", "712","713","718","725","733","734","735","738","739"}]
'Loop till you hit a homer then exit.
    For i = 1 To UBound(var)
        If [R7] = var(i) Then
            Range("C7", Range("C65536").End(xlUp)).Copy Sheets(ar(i)).Range("C65536").End(xlUp)
            Exit Sub
            End If
    Next i
End Sub

Take care

Smallman