Trying to loop

C

Cerberus

I'm trying to create a "Do Until" and I'm getting lost do to the lack of
experience. I have a code that works well if I set the active row for each
item. To make it easier on the end user I would like it to "loop" until
there is a blank row. The list will always start at row 23. The code I have
is:

Private Sub CommandWeek_Click()
Dim intStart As Integer
Dim lngEnd As Long
Dim wksOrder As Worksheet
Dim wksCut As Worksheet
Dim rngCut As Range
Dim rngFind As Range
Dim rngFound As Range

'create worksheet objects
Set wksOrder = Sheets("Order")
Set wksCut = Sheets("Cut List")

'initialize the starting row
intStart = 2

'find the last row on wksCut
'As a side note, you can use .Cells(Rows.Count, "B")
lngEnd = wksCut.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "lngEnd: "; lngEnd

'create the range in column B from the intStart row to the end
Set rngCut = wksCut.Range("B" & intStart, "B" & lngEnd)

'column B is the "File" column - do you want to search for this?
Set rngFind = wksOrder.Range("B" & ActiveCell.Row)
Debug.Print rngFind.Address(External:=True)

'search rngCut for rngFind
Set rngFound = rngCut.Find(rngFind.Value, LookIn:=xlValues)
Debug.Print rngFind.Address(External:=True)

If rngFound Is Nothing Then
MsgBox "Weekly Order has been submitted"
Else
wksCut.Range("F" & rngFound.Row).Value = wksOrder.Cells(rngFind.Row,
"C").Value
wksCut.Range("E" & rngFound.Row).Value = Date
wksCut.Range("G" & rngFound.Row).Value = wksOrder.Range("I21").Value
wksCut.Range("H" & rngFound.Row).Value = "Week"
End If

End Sub
 
M

Matthew Herbert

Cerberus,

I'm not sure where you want your loop to go, but it appears that you have
some sort of counter setup with intStart and lngEnd. If this provides the
appropriate start and end spot, you could use a For Next loop. Putting this
aside, I've placed some code below that illustrates a "Do Until" loop for
you. The loop will offset from rngAnchor until it finds a blank cell or
until it reaches the end of the spreadsheet row limit.

Best,

Matthew Herbert

Dim rngAnchor As Range
Dim lngCnt as Long

Set rngAnchor = Range("B23")

lngCnt = 0
Do Until (lngCnt = (Rows.Count - rngAnchor.Row)) Or _
(rngAnchor.Offset(lngCnt, 0).Value = vbNullString)
'do something here
lngCnt = lngCnt + 1
Loop
 
J

John_John

....or this:

Private Sub CommandWeek_Click()
Dim lngStart As Long
Dim lngEnd As Long
Dim wksOrder As Worksheet
Dim wksCut As Worksheet
Dim rngCut As Range
Dim rngFind As Range
Dim rngFound As Range

'create worksheet objects
Set wksOrder = Sheets("Order")
Set wksCut = Sheets("Cut List")

'initialize the starting row
lngStart = 2

'find the last row on wksCut
'As a side note, you can use .Cells(Rows.Count, "B")
lngEnd = wksCut.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "lngEnd: "; lngEnd

'create the range in column B from the lngStart row to the end
Set rngCut = wksCut.Range("B" & lngStart, "B" & lngEnd)

lngStart = 23
lngEnd = wksOrder.Cells(Rows.Count, 2).End(xlUp).Row

'column B is the "File" column - do you want to search for this?
Do Until lngStart > lngEnd
Set rngFind = wksOrder.Range("B" & lngStart)
Debug.Print rngFind.Address(External:=True)

If Len(rngFind) Then
'search rngCut for rngFind
Set rngFound = rngCut.Find(rngFind.Value, LookIn:=xlValues)
Debug.Print rngFind.Address(External:=True)

If rngFound Is Nothing Then
MsgBox "Weekly Order has been submitted"
Else
wksCut.Range("F" & rngFound.Row).Value = _
wksOrder.Cells(rngFind.Row, "C").Value
wksCut.Range("E" & rngFound.Row).Value = Date
wksCut.Range("G" & rngFound.Row).Value = _
wksOrder.Range("I21").Value
wksCut.Range("H" & rngFound.Row).Value = "Week"
End If
Else
Exit Do
End If
lngStart = lngStart + 1
Loop
End Sub


Ο χÏήστης "joel" έγγÏαψε:
Try this


Private Sub CommandWeek_Click()
Dim intStart As Integer
Dim lngEnd As Long
Dim wksOrder As Worksheet
Dim wksCut As Worksheet
Dim rngCut As Range
Dim rngFind As Range
Dim rngFound As Range

'create worksheet objects
Set wksOrder = Sheets("Order")
Set wksCut = Sheets("Cut List")

'initialize the starting row
intStart = 2
OrderRowCount = 2

'find the last row on wksCut
'As a side note, you can use .Cells(Rows.Count, "B")
lngEnd = wksCut.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "lngEnd: "; lngEnd

'create the range in column B from the intStart row to the end
Set rngCut = wksCut.Range("B" & intStart, "B" & lngEnd)

'column B is the "File" column - do you want to search for this?
Do while wksOrder.Range("B" & OrderRowCount) <> ""
Set rngFind = wksOrder.Range("B" & OrderRowCount)
Debug.Print rngFind.Address(External:=True)

'search rngCut for rngFind
Set rngFound = rngCut.Find(rngFind.Value, LookIn:=xlValues)
Debug.Print rngFind.Address(External:=True)

If rngFound Is Nothing Then
MsgBox "Weekly Order has been submitted"
Else
wksCut.Range("F" & rngFound.Row).Value =
wksOrder.Cells(rngFind.Row,"C").Value
wksCut.Range("E" & rngFound.Row).Value = Date
wksCut.Range("G" & rngFound.Row).Value =
wksOrder.Range("I21").Value
wksCut.Range("H" & rngFound.Row).Value = "Week"

End If
OrderRowCount = OrderRowCount + 1
Loop

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=153063

Microsoft Office Help

.
 
C

Cerberus

That worked! Thanks for everyone's help on this.

John_John said:
...or this:

Private Sub CommandWeek_Click()
Dim lngStart As Long
Dim lngEnd As Long
Dim wksOrder As Worksheet
Dim wksCut As Worksheet
Dim rngCut As Range
Dim rngFind As Range
Dim rngFound As Range

'create worksheet objects
Set wksOrder = Sheets("Order")
Set wksCut = Sheets("Cut List")

'initialize the starting row
lngStart = 2

'find the last row on wksCut
'As a side note, you can use .Cells(Rows.Count, "B")
lngEnd = wksCut.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "lngEnd: "; lngEnd

'create the range in column B from the lngStart row to the end
Set rngCut = wksCut.Range("B" & lngStart, "B" & lngEnd)

lngStart = 23
lngEnd = wksOrder.Cells(Rows.Count, 2).End(xlUp).Row

'column B is the "File" column - do you want to search for this?
Do Until lngStart > lngEnd
Set rngFind = wksOrder.Range("B" & lngStart)
Debug.Print rngFind.Address(External:=True)

If Len(rngFind) Then
'search rngCut for rngFind
Set rngFound = rngCut.Find(rngFind.Value, LookIn:=xlValues)
Debug.Print rngFind.Address(External:=True)

If rngFound Is Nothing Then
MsgBox "Weekly Order has been submitted"
Else
wksCut.Range("F" & rngFound.Row).Value = _
wksOrder.Cells(rngFind.Row, "C").Value
wksCut.Range("E" & rngFound.Row).Value = Date
wksCut.Range("G" & rngFound.Row).Value = _
wksOrder.Range("I21").Value
wksCut.Range("H" & rngFound.Row).Value = "Week"
End If
Else
Exit Do
End If
lngStart = lngStart + 1
Loop
End Sub


Ο χÏήστης "joel" έγγÏαψε:
Try this


Private Sub CommandWeek_Click()
Dim intStart As Integer
Dim lngEnd As Long
Dim wksOrder As Worksheet
Dim wksCut As Worksheet
Dim rngCut As Range
Dim rngFind As Range
Dim rngFound As Range

'create worksheet objects
Set wksOrder = Sheets("Order")
Set wksCut = Sheets("Cut List")

'initialize the starting row
intStart = 2
OrderRowCount = 2

'find the last row on wksCut
'As a side note, you can use .Cells(Rows.Count, "B")
lngEnd = wksCut.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "lngEnd: "; lngEnd

'create the range in column B from the intStart row to the end
Set rngCut = wksCut.Range("B" & intStart, "B" & lngEnd)

'column B is the "File" column - do you want to search for this?
Do while wksOrder.Range("B" & OrderRowCount) <> ""
Set rngFind = wksOrder.Range("B" & OrderRowCount)
Debug.Print rngFind.Address(External:=True)

'search rngCut for rngFind
Set rngFound = rngCut.Find(rngFind.Value, LookIn:=xlValues)
Debug.Print rngFind.Address(External:=True)

If rngFound Is Nothing Then
MsgBox "Weekly Order has been submitted"
Else
wksCut.Range("F" & rngFound.Row).Value =
wksOrder.Cells(rngFind.Row,"C").Value
wksCut.Range("E" & rngFound.Row).Value = Date
wksCut.Range("G" & rngFound.Row).Value =
wksOrder.Range("I21").Value
wksCut.Range("H" & rngFound.Row).Value = "Week"

End If
OrderRowCount = OrderRowCount + 1
Loop

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=153063

Microsoft Office Help

.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top