search replace Diogonally

:banghead: How can I search and replace diagonally, I have a range of 8 Rows by 8 Columns; r10:y17, I want to search each cell in this range , for example we start in r10
if the value of cell(r10,c10)=3 and cell(r11,c11)<0; then replace the value of cell(r11,c11) to be 1.1; where cell(r10,c10) represents cell(row10,column10)
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank and cell(r12,c12)<0 then replace the value of cell(r12,c12) by 1.1
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank and cell(r12,c12)= blank cell(r13,c13)<0 then replace the value of cell(r13,c13) by 1.1
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank, and cell(r12,c12)= blank and cell(r13,c13)= blank , cell(r14,c14)<0 then replace the value of cell(r14,c14) by 1.1
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank, and cell(r12,c12)= blank and cell(r13,c13)= blank , and cell(r14,c14)= blank ,cell(r15,c15)<0 then replace the value of cell(r15,c15) by 1.1
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank, and cell(r12,c12)= blank and cell(r13,c13)= blank , and cell(r14,c14)= blank , and cell(r15,c15)= blank ,cell(r16,c16)<0 then replace the value of cell(r16,c16) by 1.1
if the value of cell(r10,c10)=3 and cell(r11,c11)= blank, and cell(r12,c12)= blank and cell(r13,c13)= blank , and cell(r14,c14)= blank , and cell(r15,c15)= blank , and cell(r16,c16)= blank , cell(r17,c17)<0 then replace the value of cell(r17,c17) by 1.1

Then I want to chick for each cell in the range
thanks for help

it is hard to read.

it would be better to post your workbook that describe before and after.

Perhaps something like:
[VBA]Sub Diagonals()
Dim i As Integer
With ActiveSheet.Range("J10")
If .Value = 3 Then
For i = 1 To 7
If .Offset(i, i).Value < 0 Then
.Offset(i, i).Value = 1.1
ElseIf .Offset(i, i).Value <> "" Then
Exit For
End If
Next
End If
End With
End Sub[/VBA]

:hi: thank macropod; this code works fine for only one cell r10, but my range is 8 rows*8 columns r10:y17, if I go to next cell to the right s10 my diagonall will be s10,t11,u12,v13,w14,x15,y16 (rows became 6 insted of 7)
also if we go one row down r15 my diagonal will be r15,s16,t17
I mean how to limit the code withen my range 8r*8c
thanks very much for your help

Hi majed,

It wasn't clear from your post quite what you wanted to do. Your reference to "cell(r10,c10) represents cell(row10,column10)" suggested your diagonal started at J10. To have any cell as the diagonal starting point, you could change:
ActiveSheet.Range("J10")
to:
AvtiveCell

Quote:

---

Originally Posted by macropod

Hi majed,

It wasn't clear from your post quite what you wanted to do. Your reference to "cell(r10,c10) represents cell(row10,column10)" suggested your diagonal started at J10. To have any cell as the diagonal starting point, you could change:
ActiveSheet.Range("J10")
to:
AvtiveCell

---

Thanks again, i dont want to make things compex, (I want to do many things; diogonal search from top-down, and diogonal search down- top, vertical search top-down, down- top, right-left, left- right.)
I am trying to do it step by step; my range is fixed 8*8 rows & coulmns
your code is very usefull, but I have a small problme, it searchs diagonally top-down; if the first cell value =3, and diagonnally any cell value <0 it replacess it by 1.1, How can I limit the replacement to the first value <0 insted of all negative values, example: cell(row=10, column=18): r10= 3,s11=-8,t12=-2, u13=-4; your code will replace s11,t12,u13 by 1.1 , I need to change the fiirst cell s11 to 1.1 keeping others the same, is this possible.
many thanks

Hi majed,

Quote:

---

i dont want to make things compex, (I want to do many things; diogonal search from top-down, and diogonal search down- top, vertical search top-down, down- top, right-left, left- right.)

---

If that isn't complex, I don't know what is - you'll either need to have a separate macro for each case, or one very complex macro.

Quote:

---

your code is very usefull, but I have a small problme, it searchs diagonally top-down; if the first cell value =3, and diagonnally any cell value <0 it replacess it by 1.1, How can I limit the replacement to the first value <0 insted of all negative values, ... I need to change the fiirst cell s11 to 1.1 keeping others the same, is this possible.

---

Not with this macro, unless it is made more complex. That's because it's coded to do what you originally asked. Unless I re-code it to ask you to tell it what you want to do, how is it supposed to know?

When seeking help with a problem, you should state completely as possible what the problem is - not keep modifying it as each scenario is addressed.

Try:
[vba]Sub Diagonals()
Dim i As Integer, j As Integer, bTop, bLeft, bDiag, iV As Integer, iH As Integer
j = CInt(InputBox("How many steps?", , "1"))
If j < 1 Then GoTo ExitSub
bTop = MsgBox("Start at Top?", vbYesNo)
If bTop = vbYes Then bTop = 1 Else bTop = -1
bLeft = MsgBox("Start at Left?", vbYesNo)
If bLeft = vbYes Then bLeft = 1 Else bLeft = -1
bDiag = MsgBox("Process Horizontally (Yes), Vertically (No), Diagonally (Cancel)?", vbYesNoCancel)
If bDiag = vbYes Then iV = 0: iH = 1
If bDiag = vbNo Then iV = 1: iH = 0
If bDiag = vbCancel Then iV = 1: iH = 1
With ActiveCell
If .Value = 3 Then
For i = 1 To j
If .Offset(i * bTop * iV, i * bLeft * iH).Value < 0 Then
.Offset(i * bTop * iV, i * bLeft * iH).Value = 1.1
Exit For
ElseIf .Offset(i * bTop * iV, i * bLeft * iH).Value <> "" Then
Exit For
End If
Next
End If
End With
ExitSub:
End Sub[/vba]

I do appreciate your help, your code is working excellent ,I have been searching for diagonal vba cods for 8 days, I haven find any good results, It seems that you are excellent and advanced in vba, I will need some time to analyze and understand your code,
You are right again, I didn’t explain my problem well; maybe it’s a language problem, since English is not my mother language ; if you look at the following table ; things will be more clear; for example the value of cell T12 is 3 (it can be located at any cell in the range R10:Y16), my target is to search up- down, down-up, left-right, right-left, diagonal :top-down left, top-down right, down-top right, down-top left to find the first negative cell value in each direction and replace it by 1.1; in this example replace the red cells
[FONT='Calibri','sans-serif']I am sorry again [FONT='Arial','sans-serif']and thanks a lot.[/font][/font]

Attachment 5115

Hi majed,

What you're now describing seems to be different again! If I understand what you're saying correctly, you want all the processing to happen automatically. In that case, try:
[VBA]Sub Radiate()
Dim i As Integer
With ActiveCell
If .Value = 3 Then
For i = 1 To 8
If .Offset(i, i).Value < 0 Then
.Offset(i, i).Value = 1.1
Exit For
ElseIf .Offset(i, i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(i, i).Value < 0 Then
.Offset(i, i).Value = 1.1
Exit For
ElseIf .Offset(i, i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(-i, i).Value < 0 Then
.Offset(-i, i).Value = 1.1
Exit For
ElseIf .Offset(-i, i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(i, -i).Value < 0 Then
.Offset(i, -i).Value = 1.1
Exit For
ElseIf .Offset(i, -i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(-i, -i).Value < 0 Then
.Offset(-i, -i).Value = 1.1
Exit For
ElseIf .Offset(-i, -i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(i, 0).Value < 0 Then
.Offset(i, 0).Value = 1.1
Exit For
ElseIf .Offset(i, 0).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(-i, 0).Value < 0 Then
.Offset(-i, 0).Value = 1.1
Exit For
ElseIf .Offset(-i, 0).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(0, i).Value < 0 Then
.Offset(0, i).Value = 1.1
Exit For
ElseIf .Offset(0, i).Value <> "" Then
Exit For
End If
Next
For i = 1 To 8
If .Offset(0, -i).Value < 0 Then
.Offset(0, -i).Value = 1.1
Exit For
ElseIf .Offset(0, -i).Value <> "" Then
Exit For
End If
Next
End If
End With
End Sub[/VBA]

And here's a more compact version of the sub:
[vba]Sub Radiate()
Dim i As Integer, j As Integer, k As Integer
With ActiveCell
If .Value = 3 Then
For j = -1 To 1
For k = -1 To 1
For i = 1 To 8
If .Offset(i * j, i * k).Address <> ActiveCell.Address Then
If .Offset(i * j, i * k).Value < 0 Then
.Offset(i * j, i * k).Value = 1.1
Exit For
ElseIf .Offset(i * j, i * k).Value <> "" Then
Exit For
End If
End If
Next
Next
Next
End If
End With
End Sub[/vba]

Dear Paul Edstein, I am grateful for your kindness and your help, before you submit your last code (which is a master piece and works well, all though I need some time to digest it, and my be convert it into a function) I reached the following function using your previous cods:

Function mainp(h, v, f, l)
Dim i As Integer
'h = 1 ' (h=1 Down) (h=-1 UP) (h=0 no move)
'v = 1 ' (v=1 Right) (v=-1 Left) (v=0 no move)
'f = replacement value
'l= max loop value

With ActiveCell
If .value = f Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 1 To l
If .Offset(i * h, i * v).value > 0 Then ' Positive
.Offset(i * h, i * v).value = 1.1 ' Replacement value
Exit For
ElseIf .Offset(i * h, i * v).value < 0 Then 'Exit loop if negative
Exit For
End If
Next
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
End Function

The reason why I used a function is to be more flexible in using different versions of searching replacing direction: up, down, from up to left, from down to right ….etc.

Sub hrm() 'this loops the whole range r10:y17 cell by cell
Dim col As Integer
Dim row As Integer

Sheets("hrm").Select ' the name of the sheet=the name of the macro
refill
For row = 10 To 18
For col = 18 To 26
Cells(row, col).Select
'Call mainp(1, 1, -5, 7) '(h=1 Down)(v=1 Right)
' Call mainp(-1, -1, -5, 7) '(h=-1 UP) (v=-1 Left)
' Call mainp(1, -1, -5, 7) ' (h=1 Down) (v=-1 Left)
' Call mainp(-1, 1, -5, 7) ' (h=-1 UP) (v=1 Right)
Call mainp(1, 0, -5, 7) '(h=1 Down)
Call mainp(-1, o, -5, 7) ' (h=-1 UP)
Call mainp(0, 1, -5, 7) '(v=1 Right)
Call mainp(0, -1, -5, 7) '(v=-1 Left)
Next col
Next row
End Sub
The above code is slandered, it contains all directions, for example if I want down, right, up, left (horizontal & vertical) I just insert (') before the diagonal parts to disable it …etc

Thanks a lot.