Hello, I've written the code bel

[APElliott]

Hello,

I've written the code below to the best of my ability, but I would like some changes doing and don't know how to do them.

Please help!

The code currently searches for "01", but I would really like it to search for non blanks within column A from cell A2.

It also only runs to row 100, but I would like it to run until the seach ends.

Any ideas?

Thanks

Andrew

Columns("a:a&quot.Select

Dim R As Long
For R = 2 To 100
Cells.Find(What:="01", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlDown, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-1, 16).Select
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[" & _
ActiveCell.Offset(1, 0).Range("A1&quot.End(xlDown).Row _
- ActiveCell.Row & "]C)"
Selection.Copy
ActiveCell.Offset(1, -8).Value = ActiveCell.Value

ActiveCell.Value = ""
ActiveCell.Offset(2, -16).Select

Next R
End Sub

 

[Molby]

To look for non blanks, have you tried <>&quot;&quot;

Regards,

Ian

 

[JohnAcc]

This will help searh for non blanks - Searching for &quot;&quot; will not return empty if there is a formula returning &quot;&quot;

Sub SearchForNonBlankCells()
For i = 2 To 200
If Not IsEmpty(Cells(i, &quot;A&quot) Then
MsgBox Cells(i, &quot;A&quot.Address ' Do stuff Here
End If
Next i
End Sub

If you don't want the code to stop at 200 then use a do until statement

 

[Stripester]

Cheers John, Ian.

I've copied your code John, but I'm struggling a bit!

Your code doesn't seem to select the non blanks as they popup in the message box.

How do you do this?

The 'Do Until' statement sound just what I need, but I don't know where to start!

Thanks,

Andrew

 

[JohnAcc]

Hi Andrew,

If you need to select the cells as it loops through then:

Sub SearchForNonBlankCells()
For i = 2 To 200
If Not IsEmpty(Cells(i, &quot;A&quot) Then
Cells(i,&quot;A&quot.Select
MsgBox Cells(i, &quot;A&quot.Address ' Do stuff Here
End If
Next i
End Sub

What do you want to do when the cell is selected and when do you want the loop to end ?

John

 

[APElliott]

Cheers John

Every time it find a non blank in col A it select it then moves along to col Q and up 1 row it then creates a sum for the range of cells below until it finds a blank row and copies the sum.

It then moves back to col I and back down 1 cell and paste the value here.

The sum in column Q is then deleted.

I then want it to find the next non blank in A and do the same process.

I know there are probably easier ways of doing this, but it the only way I could get anywhere near on my own.

Thanks

Andrew

 

[APElliott]

John,

I,ve just found a problem with my code that creates the sum formula - it occurs if the range below is only one cell.

If this is the case it sums the cell directly below, then the blank row and 1 further cell.

Here's how the code is lookin at the moment:

Sub SearchForNonBlankCells()
For i = 2 To 200
If Not IsEmpty(Cells(i, &quot;A&quot) Then
Cells(i, &quot;A&quot.Select
MsgBox Cells(i, &quot;A&quot.Address ' Do stuff Here

ActiveCell.Offset(-1, 16).Select
ActiveCell.FormulaR1C1 = &quot;=SUM(R[1]C:R[&quot; & _
ActiveCell.Offset(1, 0).Range(&quot;A1&quot.End(xlDown).Row _
- ActiveCell.Row & &quot;]C)&quot;
Selection.Copy
ActiveCell.Offset(1, -8).Value = ActiveCell.Value

ActiveCell.Value = &quot;&quot;
ActiveCell.Offset(2, -16).Select

End If
Next i
End Sub

Thanks,

Andrew

 

[JohnAcc]

Hi Andrew,

I'm not exactly sure what your after but from what you've said I think you can manipulate the following code :

Dim Sum As Long
Sub SearchForNonBlankCells()
For i = 9 To 200
If Not IsEmpty(Cells(i, &quot;A&quot) Then
Cells(i, &quot;A&quot.Activate
ActiveCell.Offset(-1, 16).Activate
TotalSum = WorksheetFunction.Sum(Range(ActiveCell, ActiveCell.End(xlDown).Offset(-1, 0)))
Cells(i, &quot;I&quot.Value = Sum
End If
Next i
End Sub

Let me know how you get on

Cheers

John

 

[APElliott]

Cheers John,

Doesn't appear to work though

Thanks for trying

Andrew

 

[JohnAcc]

Hi Andrew,

I mis-typed a word on my previous post - my apologies - try this:

Dim TotalSum As Long
Sub SearchForNonBlankCells()
For i = 2 To 200
If Not IsEmpty(Cells(i, &quot;A&quot) Then
Cells(i, &quot;A&quot.Activate
ActiveCell.Offset(-1, 16).Activate
TotalSum = WorksheetFunction.Sum(Range(ActiveCell, _
ActiveCell.End(xlDown).Offset(-1, 0)))
Cells(i, &quot;I&quot.Value = TotalSum
End If
Next i
End Sub

' this is essentially looking for a non blank cell in col &quot;A&quot; - when it finds one - it is moving 16 cols across to col &quot;Q&quot; it is then storing the sum of the cells below it to one above the next cell with data in it (stores the sum in the variable totalsum and enters the value in col I

 

[APElliott]

Cheers John,

Stil no luck though. It's putting figures in all the correct places, but there all zero.

I've put the code in exactly as you have and I've tried it with the Dim TotalSum As Long as the first line, but still with no luck.

Any ideas?

Thanks

Andrew

 

[APElliott]

Hi John,

I've ended up with the following - i know it's not pretty, but it does exactly what I'm looking for:

Sub SearchForNonBlankCellsAndABitMore()

For i = 1 To Range(&quot;a65536&quot.End(xlUp).Row
If Not IsEmpty(Cells(i, &quot;A&quot) Then
Cells(i, &quot;A&quot.Select
MsgBox Cells(i, &quot;A&quot.Address ' Do stuff Here

ActiveCell.Offset(-1, 16).Select

If ActiveCell.Offset(2, 0) = (&quot;&quot Then

ActiveCell.Value = ActiveCell.Offset(1, 0)
Else

ActiveCell.FormulaR1C1 = &quot;=SUM(R[1]C:R[&quot; & _
ActiveCell.Offset(1, 0).Range(&quot;A1&quot.End(xlDown).Row _
- ActiveCell.Row & &quot;]C)&quot;
End If
Selection.Copy
ActiveCell.Offset(1, -8).Value = ActiveCell.Value

ActiveCell.Value = &quot;&quot;
ActiveCell.Offset(2, -16).Select

End If
Next i
End Sub

Please send me your code if you can get it working

Thanks

Andrew

 

[JohnAcc]

Hi Andrew,

Do you want to send me the workbook and i will have a look at it for you.

john.cox@purpleloans.com