PDA

View Full Version : Solved: loop help please and thank you!



vicC
07-08-2010, 07:23 AM
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.:think:

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.



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

Bob Phillips
07-08-2010, 09:09 AM
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.

vicC
07-08-2010, 01:47 PM
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.

Bob Phillips
07-08-2010, 03:19 PM
I would write it like this



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

vicC
07-09-2010, 08:35 AM
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 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
And as always thanks for your time.

Bob Phillips
07-09-2010, 08:44 AM
Do you mean this?



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

vicC
07-09-2010, 09:42 AM
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.

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
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.:think: