VBA Shortcut needed

[Guest]

Hi
The code below is my poor attempt of entering data into one cell depending
on data in another cell:

Range("E40").Select
If ActiveCell > 0 Then
Range("N40").Select
ActiveCell.FormulaR1C1 = "1"

Range("E41").Select
If ActiveCell > 0 Then
Range("N41").Select
ActiveCell.FormulaR1C1 = "1"

Range("E42").Select
If ActiveCell > 0 Then
Range("N42").Select
ActiveCell.FormulaR1C1 = "1"

Range("E40").Select
If ActiveCell > 0 Then
Range("N40").Select
ActiveCell.FormulaR1C1 = "1"

and so on and so on............

What I need is a piece of code that does a loop (I guess) that does the same
job with a fraction of the code.

I know it can be done using formulas on the page, but I am trying to get
away from that for the time being.
Any help...............

Regards
John

 

[Bob Phillips]

For Each cell In Range("E40:E400") '<===== change range to suit
If cell.Value > 0 Then
Range("N40").Value = "1"
End If
Next cell


--
HTH

Bob Phillips

(replace xxxx in email address with googlemail if mailing direct)

 

[Guest]

The following DO loop will do the trick (no pun intended).

Sub CheckVals()

Dim wb As Workbook
Dim ws As Worksheet
Dim intLoop As Integer
Dim varMatch As Variant
Dim intVal As Integer

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Range("E40").Select

Do Until intLoop = 4
intVal = ActiveCell.Offset(intLoop).Value
If intVal > 0 Then
varMatch = 1
Else
varMatch = ""
End If
ActiveCell.Offset(intLoop, 9).Value = varMatch
intLoop = intLoop + 1
Loop

Set wb = Nothing
Set ws = Nothing

End Sub

 

[Guest]

Thanks Bob, but it wont get past the first phase.
It puts the 1 into the the first cell (being N40) but then it stops.
Any ideas?

 

[Guest]

Hi Kevin,
I tried your code, but it returned a Run Time Error - Type mismatch
Any ideas?

John

 

[Ikaabod]

Try changing:
Range("N40").Value = "1"
to
cell.offset(0,9).value = "1"

Thanks Bob, but it wont get past the first phase.
It puts the 1 into the the first cell (being N40) but then it stops.
Any ideas?

 

[Guest]

Answered your previous post:

for i = 40 to 40 + 49
if cells(i,1)> 0 then
cells(i,"N").Value = 1
end if
Next

 

[Guest]

The original one worked for me, but try this one, and if that doesn't work,
try changing the variable type for intLoop to Long:

Sub CheckVals()

Dim wb As Workbook
Dim ws As Worksheet
Dim intLoop As Integer
Dim intVal As Integer

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Range("E40").Select

Do Until intLoop = 4
intVal = ActiveCell.Offset(intLoop).Value
If intVal = 0 Then
ActiveCell.Offset(intLoop, 9).Value = ""
Else
ActiveCell.Offset(intLoop, 9).Value = 1
End If
intLoop = intLoop + 1
Loop

Set wb = Nothing
Set ws = Nothing

End Sub

 

[Guest]

Hi Bob,
I have got well confused over all the feedback I got over this one, but this
code is the one that worked for me.
Many thanks to Tom, Ikaabod, Kevin also for their help
Wow I will be dishing out rewards next.
Take care
Regards
John

 

[Guest]

I am getting tired I meant this code:

For Each cell In Range("E40:E59")
If cell.Value > "" Then
Range("N40").Value = "1"
cell.Offset(0, 7).Value = "1"
End If
Next cell

Sorry chaps

 

[Bob Phillips]

After you changed it to

For Each cell In Range("E40:E400") '<===== change range to suit
If cell.Value > 0 Then
cell.Offset(0,9).Value = "1"
End If
Next cell


I hope <G>

--
HTH

Bob Phillips

(replace xxxx in email address with googlemail if mailing direct)