Macro analyses Cell.Serches for given word,the puts text in cell a

[andrei]

I have a column with a lot of cells . Something like this :

Product
Price
Some empty cells
Product
Price
Some empty cells
Price
Some empty cells
Product
Price

So , sometimes i have the price , but no product name for the cell above .
What i need is a macro which serches for keyword "price" . After that goes to
cell above . In cell above is empty puts in it " unknown product" . If cell
above has text in it ( even a single character or number ) , it leaves the
cell as it is

 

[joel]

I'm using column A (specified in 2 places). changge as required.


Set c = Columns("A").Find(what:="price", _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
If c.Offset(-1, 0) = "" Then
c.Offset(-1, 0) = "unknown product"
End If

Set c = Columns("A").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> FirstAddr
End I

 

[andrei]

Thanks , it works .

Strangely but i put the question here : 'Discussion Groups Home
(http://tinyurl.com/y7jug7)

Gave a search with google and found this forum with my question . And
answer for it Bg

I came across another problem . Sometimes i have :

Code
Product
Price
Some empty cells
Code
Product
Price
Some empty cells
CODE
PRIC
Some empty cells
Code
Product
Price

So , between Code and price i need a macro to put "unknown product"
Something like it reades the cell with "price" keyword . Goes one cel
above . If there finds "product" , it's OK . If finds else , creates
new empty row and puts "unknown product " in cell above the cell wit
"price" .

Should be something like this :

Code
Unknown product
Pric

 

[joel]

Microsoft and thecodeCage cross post submissions. Posting on one sit
will automatically show up on the other site. The email is sent fro
the site you orginally put the request. The microsoft site i
presently not working porperly. Emails are not being sent whe
responses are posted. I think I responed on both sites to thi
request.

the code below starts at the last row since you have blank cells in th
data and you are adding new rows.


Sub UnknownProduct()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow
Do While RowCount > 1
Data = Range("A" & RowCount)
If Data = "Price" Then
PreviousData = Range("A" & (RowCount - 1))
If PreviousData = "Code" Then
Rows(RowCount).Insert
RowCount = RowCount - 1
Range("A" & RowCount) = "unknown product"
End If
End If

RowCount = RowCount - 1

Loop

End Su

 

[Patrick Molloy]

thet the constant to the correct column letter.

Option Explicit
Sub checkPrice()
Const col As String = "B"
For rw = 2 To Cells(1, col).End(xlDown).Row
If Cells(rw, col) = "price" Then
If Cells(rw - 1, col) = "" Then
Cells(rw - 1, col) = "unknown product"
End If
End If
Next
End Sub

 

[Patrick Molloy]

earlier posting used xldown to get last row, given that we know there are
blanks, a more suitable approach would be to go to the bottom of the column
as use xlUp to get the last row --- ie the FOR loop has changed ...see below:

Option Explicit
Sub checkPrice()
Const col As String = "B"
Dim rw As Long
For rw = 2 To Cells(Rows.Count, col).End(xlUp).Row
If Cells(rw, col) = "price" Then
If Cells(rw - 1, col) = "" Then
Cells(rw - 1, col) = "unknown product"
End If
End If
Next
End Sub