Do While Loop Help

[f2e4]

Hey people,

I am trying to write some code that will find a value in a selected column, and once it is found, do some formatting on that row.

The steps are meant to be as follows:

Find last active row - This bit works fine

Starting in Row 3 Column 2, search down until cell value is "Leadership & Management Total"

Once value is found, select that cell and then select over to the last active column in that row.

The problem:

I had a previous Do Loop Until code that worked fine but i had to modify it as the headings I was looking for were not always there (depending on data). This threw up an error as the loop kept on going until the end of the sheet.

This code is meant to be conditional - i.e. run the code, find the value, if value is there, do teh formatting bit, if value is not there, exit do loop.


a = 3
Do While a <= lastactiverow
If Cells(a, 2) = "Leadership & Management Total" Then
Cells(a, 2).Select
'You can ignore this formatting bit, as i know this works
'Range(Selection, Cells(a, LastCol)).Select
'With Selection.Interior
'.ColorIndex = 15
'.Pattern = xlSolid
'.PatternColorIndex = xlAutomatic
'End With
'Selection.Font.ColorIndex = 2
'With Selection
'.HorizontalAlignment = xlLeft
'.VerticalAlignment = xlBottom
'.WrapText = False
'.Orientation = 0
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.ReadingOrder = xlContext
'.MergeCells = False
'End With
Else
Exit Do
End If
a = a + 1
Loop


Hope someone can sort this out

And as always, thanks for the help

[Simon Lloyd]

Well i don't know if you have lots of the same title on the sheet but for a one off this will work:

Dim Rng As Range
Set Rng = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
With ActiveSheet.Range(Rng.Address)
Cells.Find(What:="Leadership & Management Total", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
End With

[Simon Lloyd]

On second thoughts this will loop through all the cells in the range and find occurences, just change the MsgBox statement for your copy statement!

Public Sub FindMyWord()
Dim rFound As Variant, Rng As Range
Set Rng = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
With Rng
Set rFound = .Find("Leadership & Management Total", LookIn:=xlValues)
If Not rFound Is Nothing Then
FirstAddress = rFound.Address
Do
If Not rFound.Address = FirstAddress Then LastAddress = rFound.Address
Set rFound = .FindNext(rFound)
MsgBox rFound.Address
Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
End If
End With
End Sub

[f2e4]

Well i don't know if you have lots of the same title on the sheet but for a one off this will work:

Dim Rng As Range
Set Rng = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
With ActiveSheet.Range(Rng.Address)
Cells.Find(What:="Leadership & Management Total", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
End With


Hi Simon,

Thanks for the reply.

I'm trying out your code now and it does work with finding the value - they are only one-off values.

But now i'm not sure how to do my range selection for that whole row up to the last active column like before:


Range(Selection, Cells(a, LastCol)).Select

[Simon Lloyd]

perhaps

Range(ActiveCell, Cells(a, LastCol)).Select
Subscript 9 suggests that the particular sheet you are referencing doesnt exist, check spelling and/or spaces in the name.

[f2e4]

perhaps

Range(ActiveCell, Cells(a, LastCol)).Select
Subscript 9 suggests that the particular sheet you are referencing doesnt exist, check spelling and/or spaces in the name.

Yeah the subscript thing was a spelling mistake by me

The code below worked before as 'a' was stored as a row reference but now with your new code:


Dim Rng As Range
Set Rng = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
With ActiveSheet.Range(Rng.Address)
Cells.Find(What:="Leadership & Management Total", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
End With


'a' is not used.

What can i replace 'a' with to put in the new row reference:

Range(ActiveCell, Cells(a, LastCol)).Select

I tried this for the hell of it but this selects everything:

Range(ActiveCell, Cells(Rows.Count, LastCol)).Select

[Simon Lloyd]

Because the code i supplied "Activates" a cell a now becomes ActiveCell.Row

[f2e4]

yep that works fine now

I have a total of 5 headings:

Leadership & Management Total
Projects Total
Prospects (Live) Total
Prospects (Potential) Total
Other Total

So i have had to duplicate your code for each one of these headings

However, my final problem is now that if one of these headings is not on this particular report, i get an error.

Is there any way to add a condition so that if the heading is not in that report, then skip that bit of code?

[Simon Lloyd]

Firstly have the headings in a list on another sheet and use a for next loop to go through them all, secondly you need to add error handling in the form of On Error Goto or using an If statement, have a little experiment with it.

[Simon Lloyd]

Your loop looks like this:


Dim Rng As Range ,Rng1 As Range,MyCell as Range
Set Rng = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
Set Rng1 = Range......enter the range of your list
With ActiveSheet.Range(Rng.Address)
For Each MyCell In Rng1
Cells.Find(What:="Leadership & Management Total", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Next MyCell
End With