SpecialCells used to enter data

[Gary]

I have a script I acquired from a website, slightly modified, but still need
help. The following script places the text "formula here" in every cell (in
column B) where there exists an entry. What I would like to do is place the
text in the cell to the right of where an entry exists. In otherwords the
text "formula here" would fall under column C in every row there exists an
entry in column B. I tried using the OFFSET command within the script but
with no success.

I might add the the range of entries in column B will change from time to
time. For example there may be entries in the first 10 rows whereas another
time there may be entries in the first 5000 rows. The first row will always
serve as a header.

Any suggestions?
Thanks,
Gary


Sub detect_data()
If WorksheetFunction.CountA(Range("B:B")) = 0 Then
MsgBox "Please enter data", vbOKOnly, "Alert!"
Exit Sub
End If
On Error Resume Next
Range("B:B").SpecialCells(xlCellTypeConstants) = "formula here"
On Error GoTo 0
End Sub

 

[Frank Kabel]

Hi
try
Sub detect_data()
dim rng as range
dim cell as range
If WorksheetFunction.CountA(Range("B:B")) = 0 Then
MsgBox "Please enter data", vbOKOnly, "Alert!"
Exit Sub
End If
On Error Resume Next
set rng = Range("B:B").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
if rng is nothing then exit sub
for each cell in rng
cell.offset(0,1).value="your_text"
next
End Sub

 

[Andoni]

'For sure there are many other ways, but i think this is the fastest
'one, mainly when the inputs in colum("B") increase

Sub Andoni()
Dim LastRow As Long
Dim Rng As Range
Dim RngData_1 As Variant
Dim RngData_2() As Variant
Dim X As Long

With ActiveSheet
.UsedRange 'Reset last Cell
'Gets the last non empty cell in ThisWorkSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
'Set a Range named Rng to the B column data rows
Set Rng = Range("B1", Cells(LastRow, "B"))
'Gets the range's Rng values to RngData_1
RngData_1 = Rng.Value
End With
'takes the proper arrays size
ReDim RngData_2(1 To UBound(RngData_1, 1), 1 To 1)
For X = 1 To UBound(RngData_1, 1)
If IsEmpty(RngData_1(X, 1)) = False Then
RngData_2(X, 1) = "Formula Here"
End If
Next X
'applies the desired "Formula"
Range("C1").Resize(UBound(RngData_1, 1), 1).Value
RngData_2

End Su

 

[Gary]

Fabulous! Worked like a charm.

Many thanks!
Gary