Consulting

Results 1 to 7 of 7

Thread: Solved: loop help please and thank you!

  1. #1
    VBAX Regular
    Joined
    Feb 2010
    Posts
    21
    Location

    Solved: loop help please and thank you!

    Hi again

    I have a loop that seems to stop working after two cells in a list than drops out of loop. I can not see why. It has a simple if statement in it. I just can not make it work.

    I attached the workbook.
    The code is in module 3

    Loop works through list on sheet3 in col (D) , but when PM is selected on the interface sheet, and sheet3.range("A3") is false the loop it is to work down col (E).


    This is my first loop and I almost have it. The loop finds cell on DBtable that I am going to paste data into.

    myvalue3 is not used.

    thanks for any help. and your time.


    [vba]
    Sub looptest()
    Dim myvalue As Long
    Dim myvalue2 As Long
    Dim myvalue3 As Long
    Sheet3.Activate
    If Range("a3") = True Then

    Range("d:d").Activate

    Else
    Range("e:e").Activate
    End If
    Do

    myvalue = WorksheetFunction.Match(ActiveCell.Value, Sheet1.Range("headers"), 0)
    myvalue2 = WorksheetFunction.Match(Sheet3.Range("a1"), Sheet1.Range("b:b"), 0)
    'Do
    'myvalue3=
    Sheet3.Range("Ampcu").Copy
    Sheet1.Activate

    Sheet1.Cells(myvalue2, myvalue).Select 'Activate
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Range(Cells(myvalue2, myvalue)).Value = Range("Ampcu").Value

    MsgBox (myvalue)
    Sheet3.Activate
    ActiveCell.Offset(1, 0).Select

    Loop Until IsEmpty(ActiveCell.Offset(0, 1))

    End Sub
    [/vba]
    Last edited by Bob Phillips; 07-08-2010 at 03:21 PM. Reason: Added VBA tags

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    I don't like the use of activecell, can cause all sorts of problems.

    But the reason that it stops after 2 is because if A3 is True it activates column D, if it is False it activates column E, and then tests for blank in the next column. In F there are just two items, so it ends ater these.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Feb 2010
    Posts
    21
    Location
    xld thanks for the help

    Thats is the danger in using something you do not understand. Just a little more help please. If I am understanding right. The first of these two lines of code
    selects the next cell in the same column, and the second keeps the loop going as long as something is in 1 column to the right.
    ActiveCell.Offset(1, 0).Select

    Loop Until IsEmpty(ActiveCell.Offset(0, 1))

    But I do not need to keep going if something is the next column. I need to keep going if something is in the same column next cell.So than i need to change the last line to somthing like this?
    Loop Until IsEmpty(ActiveCell.Offset(1, 0))

    and that works thanks again.

    How would you wright the same code? I know that it should have error traps in it and I have not even looked at how to do that.

    What would you use besides activecell? I think I see why I did not even know I was look at the next column.

    Thanks again for your time.

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    I would write it like this

    [vba]

    Sub looptest()
    Dim colNum As Long
    Dim cell As Range
    Dim myvalue2 As Long
    Dim myvalue3 As Long

    With Sheet3

    colNum = IIf(.Range("A3").Value2, 4, 5)

    For Each cell In .Range(.Cells(1, colNum), .Cells(1, colNum).End(xlDown))

    myvalue = WorksheetFunction.Match(cell.Value, Sheet1.Range("headers"), 0)
    myvalue2 = WorksheetFunction.Match(.Range("A1"), Sheet1.Range("B:B"), 0)

    .Range("Ampcu").Copy
    Sheet1.Cells(myvalue2, myvalue).PasteSpecial Paste:=xlPasteValues

    MsgBox myvalue
    Next cell
    End With

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Feb 2010
    Posts
    21
    Location
    thanks for the code XLD

    It was eye opening and ah! at the same time.

    I have used it and came up with this it seems to work, but now I have to add in the 3rd Variant. I have named all of the areas to be copied. they are listed on sheet 3 col (f) and (g). how would I add xname into the loop. So the named range can be copied into the activecell within the loop [vba]Sub looptest4()
    Dim xrow As Long
    Dim xcol As Long
    Dim cell As Range
    Dim xname As Variant 'this is the name of an named range to be copied in sheet3.range("f") or ("G")

    With Sheet3
    xrow = WorksheetFunction.Match(.Range("A1"), Sheet1.Range("B:B"), 0) 'row number
    If .Range("a3").Value2 Then
    For Each cell In .Range(.Cells(1, 4), .Cells(1, 4).End(xlDown))
    xcol = WorksheetFunction.Match(cell.Value, Sheet1.Range("headers"), 0) 'column number

    '.Range(xname).Copy
    Sheet1.Activate
    Sheet1.Cells(xrow, xcol).Select '.PasteSpecial Paste:=xlPasteValues
    Sheet3.Activate
    Next cell
    Else
    For Each cell In .Range(.Cells(1, 5), .Cells(1, 5).End(xlDown))
    xcol = WorksheetFunction.Match(cell.Value, Sheet1.Range("headers"), 0) 'column number

    '.Range(xname).Copy
    Sheet1.Activate
    Sheet1.Cells(xrow, xcol).Select '.PasteSpecial Paste:=xlPasteValues
    Sheet3.Activate
    Next cell
    End If
    End With
    End Sub
    [/vba] And as always thanks for your time.

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Do you mean this?

    [vba]

    Sub looptest4()
    Dim xrow As Long
    Dim xcol As Long
    Dim cell As Range
    Dim xname As Variant 'this is the name of an named range to be copied in sheet3.range("f") or ("G")

    With Sheet3
    xrow = WorksheetFunction.Match(.Range("A1"), Sheet1.Range("B:B"), 0) 'row number
    If .Range("a3").Value2 Then
    Set xname = In .Range(.Cells(1, 4), .Cells(1, 4).End(xlDown))
    Else
    Set xname = .Range(.Cells(1, 5), .Cells(1, 5).End(xlDown))
    End If

    Range(xname).Copy Sheet1.Cells(xrow, "A")
    End With
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    VBAX Regular
    Joined
    Feb 2010
    Posts
    21
    Location
    Thanks again for your help.
    I came up with this on my own before checking back.
    do you think there is anything wrong with doing it this way.

    [vba]Sub looptest4()
    Dim xrow As Long
    Dim xcol As Long
    Dim cell As Range
    Dim xname As Variant 'this is the name of an named range to be copied in sheet3.range("f") or ("G")

    With Sheet3
    xrow = WorksheetFunction.Match(.Range("A1"), Sheet1.Range("B:B"), 0) 'row number
    If .Range("a3").Value2 Then
    For Each cell In .Range(.Cells(1, 4), .Cells(1, 4).End(xlDown))
    xcol = WorksheetFunction.Match(cell.Value, Sheet1.Range("headers"), 0) 'column number
    xname = cell.Offset(0, 2).Value
    .Range(xname).Copy
    Sheet1.Activate
    Sheet1.Cells(xrow, xcol).PasteSpecial Paste:=xlPasteValues
    Sheet3.Activate
    Next cell
    Else
    For Each cell In .Range(.Cells(1, 5), .Cells(1, 5).End(xlDown))
    xcol = WorksheetFunction.Match(cell.Value, Sheet1.Range("headers"), 0) 'column number
    xname = cell.Offset(0, 2).Value
    .Range(xname).Copy
    Sheet1.Activate
    Sheet1.Cells(xrow, xcol).PasteSpecial Paste:=xlPasteValues
    Sheet3.Activate
    Next cell
    End If
    End With
    End Sub[/vba]
    You have giving a lot to learn, but I seem to be getting it little by little.

    thanks for your time I will want for your replay.
    Last edited by vicC; 07-09-2010 at 10:01 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •