CELLS.FIND... Where value > 0 (EXCEL VBA)

[noboffinme]

Hi

I have the below code to go through months of data from left to right, row by row & find the first value that is > 0, then copy the records on that row back 6 columns from that value & also forward 6 months & paste into a new worksheet.

I'm stuck on the > 0 value for the 'Cell,Find...' syntax.

Here's the code so far;

Option Explicit
Sub test_range()

Dim i As Integer
Dim FinalRow As Integer

FinalRow = Cells(65536, 1).End(xlUp).Row

Sheets.add().Name = "RESULTS"

For i = 2 To FinalRow

Sheets("Sheet1").Select

Range("B" & i).Select

'----------------------------------------------------------

'Here's (below) where I need to add something like the "ActiveCell > 0" (which doesn't work), what can I put here in the 'What' section to get only values > $0?

'--------------------------------------------------------


Cells.Find(What:=(ActiveCell > 0), After:=Activecell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select

ActiveCell.Offset(-1, -7).Range("B2:N2").Copy

Sheets("Results").Select

Cells.Range("A" & i).Select

Sheets("Results").Paste

Next i

End Sub

Thanks for any helpful suggestions.

 

[vbaInet]

You would get a better response if you move this to the Excel section of the forum

This section is Modules & VBA for Ms Access.

 

[chergh]

The 'find' method doesnt work like that. You'll need to set up a loop to go through cells.

 

[noboffinme]

Thanks Chergh

Can you give me an example that fits within this code sample?

I saw some examples where I could put in a range of cells into the 'What' section but it only picked up the first value, your solution sounds better but I'm not sure where to start as I will have 1000s of potential values to test for each row.

OR maybe Cells.Find isn't what I need...

The purpose of this line is to step from a cell in column 'B', left to right, & select the first cell with a value greater than 0.

(Once the first cell that is > 0 is found, the code copies back 6 & forward 6 columns.)

I can't think of an efficient replacement for this.......

Any advice for this problem?

Also, thanks to VBAInet for placing this post correctly for me : >

 

[vbaInet]

Also, thanks to VBAInet for placing this post correctly for me : >

Actually a moderator did that for you

 

[Brianwarnock]

The purpose of this line is to step from a cell in column 'B', left to right, & select the first cell with a value greater than 0.

(Once the first cell that is > 0 is found, the code copies back 6 & forward 6 columns.)

Q1 What happens if >0 is before col F
Q2 Do you mean copy 12 cells from that row to the new sheet or just 2.
In other words if >0 is in say H12 what cells do you want copied.
Q3 Are you going to Delete the cells whose data you have copied?

Brian

 

[noboffinme]

Hi Brianwarnock

Q1 What happens if >0 is before col F - I was going to add some code that just copies what is available to the left of the first cell > 0 if there aren't 6 available. (If you have any suggestions, pls advise)


Q2 Do you mean copy 12 cells from that row to the new sheet or just 2. - Once a cell > 0 is selected, I want to copy 6 columns (in that row) back from the selected cell & also 6 columns ahead of the selected cell, this would give me a string of 13 cells with the 7th one (from the left) being > 0

Q3 Are you going to Delete the cells whose data you have copied? - No, I just want to copy & paste into a new worksheet in the same workbook.

I have attached the workbook with dummy data I'm using to get this to work, Cheers


Thanks

 

[Brianwarnock]

I haven't messed with the number of cells merely copying the entire row as I think that there are some more questions like
Don't you want colA so that you have the product
dont you want the column headings so that you Know the months
you have to allow for the number of cells being less than 6 at both the start and end of the row.

Hope this gets you going

BTW all of your rows contained a cell > 0

Brian

Sub getcells()
'Written by Brian Warnock Mar 2010
'

Dim myrange As Range
Dim lastrow As Long, lastcol As Long
Dim lastrowR As Long
Dim r As Long, c As Range
Dim flag As Integer
Dim x As Range
With Sheets("Source_Data").UsedRange
lastcol = .Cells(1, 1).Column + .Columns.Count - 1
lastrow = .Cells(1, 1).Row + .Rows.Count - 1
End With

With Sheets("results").UsedRange
lastrowR = .Cells(1, 1).Row + .Rows.Count - 1
End With

flag = 0
For r = 2 To lastrow Step 1
Set myrange = Sheets("SOURCE_DATA").Range(Cells(r, 2), Cells(r, lastcol))
    For Each c In myrange
   'x = c.Address
    If c.Value > 0 Then
    flag = 1
    Exit For
    End If
    Next c
    If flag = 1 Then
        c.EntireRow.Copy
        Sheets("results").Rows(lastrowR).PasteSpecial
        Application.CutCopyMode = False
        flag = 0
        lastrowR = lastrowR + 1
        End If
Next r

End Sub

 

[noboffinme]

Thanks Brian

This definitely helps!!

This is more useful for my purpose than Cells.Find so thanks for your time, Cheers : )

 

[Brianwarnock]

If you don't post again I'll assume that you have solved all your problems.
Its late here so I'll be closing now but will be back on at the weekend.

Brian

 

[Brianwarnock]

Thinking about this, and realising that I don't know why you are doing this and what you intend to do with the results, a couple of things crossed my mind.

1 Don't you want the product
2 don't you want the headings

Ok i've mentioned those before

3 Since the data in the 6 cells to the left will be definition be 0, why do you want them? I t makes things simpler if you don't.
4 I you let the copy run past the lastcolumn you will pick up empty cells so why worry.

With the above in mind I have altered my macro to iclude on the results sheet product, heading for first col >0 and the 6 cols after.

Note that I have altered the data for test purposes.

I know its not what you asked for and may go straight into the bin, but hey I couldn't resist meddling.

Cheers

Brian

 

[noboffinme]

Hi Brian

I'm impressed with your tenacity!

I should explain what this is designed for as it will make more sense.

This will be a tool to use for Customers 'Take up' of products & perhaps show trends of behaviours when a product is purchased & afterwards.

The point of looking for '0's is that I want to ensure the Customer had not used that product in the previous 6 columns (months).

I could then for example use this to support a case of 'x'% of these 'New' Customers who purchased Product1 also purchased Product2 withing 4 months.

I've had to adapt my code further & after checking how your code worked, I found I needed to be able to select the actual cell that was > 0 & then select the cells 6 columns (months) before & 6 after - I couldn't get your macro to do that with my skill level (although I will definitely keep that code handy!).

You'll see I added the headings & months on the RESULT worksheet, Note the Months headings can only be the 'Previous' 6, 5, 4,3,2,1 'Start Month' & 'Past' 1-6 months as each row may have the first > 0 figure in any given month depending on the 'take up' month.

I've attached the latest file for you to look at as you may have some suggestions to improve it. Cheers