Help required with a simple Loop

Good morning all,

I need a little help with a simple bit of code. (VBA Novice)

Basically what I am trying to do is find the cost centre 46731JA2 in column B and highlight it and any blank cells underneath it yellow. I am doing this for about 60 different cost centres. The code below seems to work fine (although I am open to suggestions as to where I may have gone the wrong way about it) except the problem is that some of the cost centres do no appear in every export.

The Problem is that if the cost centre does not appear in the export the Macro runs to the bottom of the page then causes an error.

How do I make it stop and move on to searching for the next cost centre if this occurs?

Thanks in advance

THE CODE:

Dim Found46731JA2 As String

Range("B1").Select
Found46731JA2 = ActiveCell.Value

Do Until Found46731JA2 = "46731JA2"
Found46731JA2 = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Activate
Loop

Selection.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Activate

Do While ActiveCell = ""
Selection.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Activate
Loop

Dim Found46731JA2 As String
Dim i As Long
Dim iLastRow as long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row

Found46731JA2 = "46731JA2"
For i = 1 To iLastRow
If Cells(i,"B").Value = Found46731JA2 Then
Do
i = i + 1
If Cells(i,"B").Value = "" Then
Cells(i,"B")..Interior.ColorIndex = 6
EndIf
Loop Until Cells(i,"B").Value = ""
Next i


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Pedros" <[email protected]> wrote in
message news:[email protected]...
>
> Good morning all,
>
> I need a little help with a simple bit of code. (VBA Novice)
>
> Basically what I am trying to do is find the cost centre 46731JA2 in
> column B and highlight it and any blank cells underneath it yellow. I
> am doing this for about 60 different cost centres. The code below
> seems to work fine (although I am open to suggestions as to where I may
> have gone the wrong way about it) except the problem is that some of the
> cost centres do no appear in every export.
>
> The Problem is that if the cost centre does not appear in the export
> the Macro runs to the bottom of the page then causes an error.
>
> How do I make it stop and move on to searching for the next cost centre
> if this occurs?
>
> Thanks in advance
>
> THE CODE:
>
> Dim Found46731JA2 As String
>
> Range("B1").Select
> Found46731JA2 = ActiveCell.Value
>
> Do Until Found46731JA2 = "46731JA2"
> Found46731JA2 = ActiveCell.Offset(1, 0).Value
> ActiveCell.Offset(1, 0).Activate
> Loop
>
> Selection.Interior.ColorIndex = 6
> ActiveCell.Offset(1, 0).Activate
>
> Do While ActiveCell = ""
> Selection.Interior.ColorIndex = 6
> ActiveCell.Offset(1, 0).Activate
> Loop
>
>
> --
> Pedros
> ------------------------------------------------------------------------
> Pedros's Profile:
http://www.excelforum.com/member.php...o&userid=28202
> View this thread: http://www.excelforum.com/showthread...hreadid=564521
>

Bob, thanks for replying.

I get the following error when I copied that code into my macro:

Compile error:

Next without For


Am I doing something wrong?
Also I assume that the .. before the interior colour line should just be a single .?

Thanks again for your time, it is much appreciated!!!!

Sorry, my bad

Dim Found46731JA2 As String
Dim i As Long
Dim iLastRow As Long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row

Found46731JA2 = "46731JA2"
For i = 1 To iLastRow
If Cells(i, "B").Value = Found46731JA2 Then
Do
Cells(i, "B").Interior.ColorIndex = 6
i = i + 1
Loop Until Cells(i, "B").Value <> ""
End If
Next i

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Pedros" <[email protected]> wrote in
message news:[email protected]...
>
> Bob, thanks for replying.
>
> I get the following error when I copied that code into my macro:
>
> Compile error:
>
> Next without For
>
>
> Am I doing something wrong?
> Also I assume that the .. before the interior colour line should just
> be a single .?
>
> Thanks again for your time, it is much appreciated!!!!
>
>
> --
> Pedros
> ------------------------------------------------------------------------
> Pedros's Profile:
http://www.excelforum.com/member.php...o&userid=28202
> View this thread: http://www.excelforum.com/showthread...hreadid=564521
>

Thanks Bob,

I have changed tact slightly.......

The code below does exactly what I want it to do. It highlights the rows I require once it finds the right text......but...... It has an error when the text is not contained in the spreadsheet (same problem as before). I have tried to merge your code with the code I have written bu have been unsuccesful.

My aim is to search through a large data set exported from a database and cut, copy and format the data onto a new sheet.

Please help.....

Sub CutCopy()

Sheets("Base Data").Select

Dim Found4173RJAB As String

Range("B1").Select
Found4173RJAB = ActiveCell.Value

Do Until Found4173RJAB = "4173RJAB"
Found4173RJAB = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Activate
Loop

Rows(ActiveCell.Row).Select
ActiveCell.Offset(0, 1).Activate

FirstRow = ActiveCell.Row
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(-1, 0).Activate
LastRow = ActiveCell.Row
Rows(FirstRow & ":" & LastRow).Select


End Sub

Mine should work fine for that, whereas yours will loop until error if no
data. Did you try it?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Pedros" <[email protected]> wrote in
message news:[email protected]...
>
> Thanks Bob,
>
> I have changed tact slightly.......
>
> The code below does exactly what I want it to do. It highlights the
> rows I require once it finds the right text......but...... It has an
> error when the text is not contained in the spreadsheet (same problem
> as before). I have tried to merge your code with the code I have
> written bu have been unsuccesful.
>
> My aim is to search through a large data set exported from a database
> and cut, copy and format the data onto a new sheet.
>
> Please help.....
>
> Sub CutCopy()
>
> Sheets("Base Data").Select
>
> Dim Found4173RJAB As String
>
> Range("B1").Select
> Found4173RJAB = ActiveCell.Value
>
> Do Until Found4173RJAB = "4173RJAB"
> Found4173RJAB = ActiveCell.Offset(1, 0).Value
> ActiveCell.Offset(1, 0).Activate
> Loop
>
> Rows(ActiveCell.Row).Select
> ActiveCell.Offset(0, 1).Activate
>
> FirstRow = ActiveCell.Row
> ActiveCell.Offset(1, 0).Activate
> Do While ActiveCell = ""
> ActiveCell.Offset(1, 0).Activate
> Loop
> ActiveCell.Offset(-1, 0).Activate
> LastRow = ActiveCell.Row
> Rows(FirstRow & ":" & LastRow).Select
>
>
> End Sub
>
>
> --
> Pedros
> ------------------------------------------------------------------------
> Pedros's Profile:
http://www.excelforum.com/member.php...o&userid=28202
> View this thread: http://www.excelforum.com/showthread...hreadid=564521
>

I tried it but couldn't get it to work.

I assume that it has something to do with me butchering it to change it from colouring to highlighting rows.

I want it to select the row that the text is found in and then every row under that until there it text in the cell below the cell that contained the text I was searching for.

The text search is taking place in column b.

any ideas on how I can achieve that?

I really appreciate your time, thanks.

That is exactly what I did, or at least as I understand you. In what way
does it not work?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Pedros" <[email protected]> wrote in
message news:[email protected]...
>
> I tried it but couldn't get it to work.
>
> I assume that it has something to do with me butchering it to change it
> from colouring to highlighting rows.
>
> I want it to select the row that the text is found in and then every
> row under that until there it text in the cell below the cell that
> contained the text I was searching for.
>
> The text search is taking place in column b.
>
> any ideas on how I can achieve that?
>
> I really appreciate your time, thanks.
>
>
> --
> Pedros
> ------------------------------------------------------------------------
> Pedros's Profile:
http://www.excelforum.com/member.php...o&userid=28202
> View this thread: http://www.excelforum.com/showthread...hreadid=564521
>

Bob (or anyone esle that can help),

I have written out the code with a lot of descriptions to try to clarify what I am trying to do. Basically the code below does exactly what I want it to do from start to finish (except that it needs to be repeated for about 30 general ledger codes) but the only problem is that an error occurs when the general ledger code does not exist in "Base Data" sheet.

Bob, the code that you wrote does search the sheet and does continue on if the general ledger number cannot be found..... which is exactly what I want it to do...... however it then colours the cells yellow. It colours the cells in the right rows as I need selected so it is very close to doing everything that I want........ However as you can see by my code I want to select the rows that contain the cells your code colours so that I can copy and paste them to a new sheet for formatting and reporting.

I am sure that the code you provided me with will perform the task I want it to but I have been incapable of completing it myself and need a little help. Some basic descriptions with the code would be very helpful and aid my development too if you are willing to provide them.

I hope I have been clear enough this time.

I am really appreciative of your time and effort and apologise for not being clear enough.


The code:


Sub AgencyData()

'Change Export sheets name to base Data
Sheets("A").Name = "Base Data"

'A sheet "Agency Data" to paste the required exported data to.
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Agency Data"

'Run Macro's to find, copy and paste the data
CutCopy
CutCopy1


End Sub


Sub CutCopy()

'Select the Base data sheet
Sheets("Base Data").Select

Dim Found4173RJAB As String

'Select column B
Range("B1").Select
Found4173RJAB = ActiveCell.Value

'Find the General ledger number "4173RJAB" in the Base Data Sheet
Do Until Found4173RJAB = "4173RJAB"
Found4173RJAB = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Activate
Loop

'Select the row containing 4173RJAB
Rows(ActiveCell.Row).Select

'Select column B in the highlighted row
ActiveCell.Offset(0, 1).Activate

'Make the current Row the first row of a row selection
FirstRow = ActiveCell.Row

'Move the Active Cell to the row underneath the 4173RJAB so that a search can begin for the next cell below
'4173RJAB that contains text
ActiveCell.Offset(1, 0).Activate

'Search for the next cell below 4173RJAB that contains text
Do While ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop

'Move the Active Cell up one so that the active cell is the last blank cell below 4173RJAB
ActiveCell.Offset(-1, 0).Activate

'Make the last blank cell below 4173RJAB the last row in the row selection for copying and pasting
LastRow = ActiveCell.Row
'Select all rows from the first row to the last row
Rows(FirstRow & ":" & LastRow).Select

'Copy the selection and move the active cell to J1 on the Agency Data Sheet
Selection.Copy
Sheets("Agency Data").Select
Range("J1").Select


Dim Marker As Boolean

'Find the next blank Cell in the J Column
Do While Marker = False
If ActiveCell.Value = "" Then
Marker = True
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
'Select the Row containing the next blank row in column J
Rows(ActiveCell.Row).Select

'Paste the copied data into the selected row.
ActiveSheet.Paste


End Sub


'REPEAT THE PROCESS FOR THE NEXT GENERAL LEDGER CODE AND PAST IT UNDERNEATH THE LAST PASTED DATA
Sub CutCopy1()

Sheets("Base Data").Select

Dim Found4173AJAS As String

Range("B1").Select
Found4173AJAS = ActiveCell.Value

Do Until Found4173AJAS = "4173AJAS"
Found4173AJAS = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Activate
Loop

Rows(ActiveCell.Row).Select
ActiveCell.Offset(0, 1).Activate

FirstRow = ActiveCell.Row
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(-1, 0).Activate
LastRow = ActiveCell.Row
Rows(FirstRow & ":" & LastRow).Select

Selection.Copy
Sheets("Agency Data").Select
Range("J1").Select

Dim Marker As Boolean

Do While Marker = False
If ActiveCell.Value = "" Then
Marker = True
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
Rows(ActiveCell.Row).Select

ActiveSheet.Paste


End Sub

I have managed to sort out the problem by using the ON Error Goto function.

It is probably a pretty clumsy way to get around the problem but it seems to work none the less.

If anyone would like to suggest cleaning code I would be happy to learn from it.

Thanks for all of your time bob, much appreciated!!

Pedros,

Here is a re-written version of AgencyData and CutCopy. I haven't worked on
CutCopy1 as it seems to do the same thing.

Sub AgencyData()

'Change Export sheets name to base Data
Sheets("A").Name = "Base Data"

'A sheet "Agency Data" to paste the required exported data to.
Sheets.Add.Name = "Agency Data"

'Run Macro's to find, copy and paste the data
CutCopy
CutCopy1

End Sub


Sub CutCopy()
Const Found4173RJAB As String = "46731JA2"
Dim Marker As Boolean
Dim i As Long
Dim iStart As Long
Dim iEnd As Long
Dim rngTarget As Range
Dim iLastRow As Long
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Set wsSource = Worksheets("Base Data")
Set wsTarget = Worksheets("Agency Data")
Set rngTarget = wsTarget.Range("A1")

With wsSource

iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
'create a dummy last row just in case
.Cells(iLastRow, "B") = "999999999999999"

For i = 1 To iLastRow

If .Cells(i, "B").Value = Found4173RJAB Then

iStart = .Cells(i, "B").Row

'loop through until we pass all blank rows
Do
i = i + 1
Loop Until .Cells(i, "B").Value <> ""

'set the pointer to the previous row, the
'last empty row
i = i - 1
iEnd = i

'copy all rows from the first to last
.Rows(iStart & ":" & iEnd).Copy rngTarget
'determine next free cell in target sheet
Set rngTarget = rngTarget.Offset(iEnd - iStart + 1, 0)

End If

Next i

'clear the dummy last row
.Cells(iLastRow, "B") = ""

End With

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Pedros" <[email protected]> wrote in
message news:[email protected]...
>
> I have managed to sort out the problem by using the ON Error Goto
> function.
>
> It is probably a pretty clumsy way to get around the problem but it
> seems to work none the less.
>
> If anyone would like to suggest cleaning code I would be happy to learn
> from it.
>
> Thanks for all of your time bob, much appreciated!!
>
>
> --
> Pedros
> ------------------------------------------------------------------------
> Pedros's Profile:
http://www.excelforum.com/member.php...o&userid=28202
> View this thread: http://www.excelforum.com/showthread...hreadid=564521
>