PDA

View Full Version : Solved: Insert 1 or 2 rows if the cell value equals a fixed word



osce
07-20-2006, 07:34 AM
I am looking for a macro to run once the fixed word in cell A13 for example equals to "Health" and after the macro found the that cell will insert 1 to 3 rows and writing the following;
Cell A14 = "Health group A" --- This should be first row to be inserted
Cell A15 = "Health group B" --- This should be 2nd row to be inserted
Cell A16 = "Health group C" --- This should be 3rd row to inserted.
And than the macro should also read the information in Cell B13 and copy it in B14 where the first row has been inserted and so on till the last row inserted.

:think: Any help will be very much appreciated

Killian
07-20-2006, 08:18 AM
Hi and welcome to VBAX :hi:
This code can be run to update the sheetDim i As Long
Dim rng As Range

Set rng = Range("A13")

If UCase(rng.Value) = "HEALTH" Then
For i = 3 To 1 Step -1
rng.Offset(1, 0).EntireRow.Insert
rng.Offset(1, 0).Value = "Health group " & Chr(64 + i)
rng.Offset(1, 1).Value = rng.Offset(0, 1).Value
Next i
End If
or do you need to activate this as the text is entered by the user?
or for cells other than A13?

osce
07-21-2006, 01:05 AM
Hi, :hi:

Thank you very much for the code. It is working perfectly :thumb . I hope I can ask for more codes.
It is not necessarily that the ?Health? word is in cell A13. Is it possible that the micro find the word ?Health? in column A and for each word ?Health? insert the 3 columns and write Health Group A,?. B...and C.

Thank you very much for you support and help

Joy

Killian
07-21-2006, 02:11 AM
You can use a "Find/FindNext" loop to get all the occurances of "Health" in column A and call the InsertRows routine each time one is foundSub main()

Dim c As Range
Dim f As String

'with column A
With ActiveSheet.Columns(1)
'find string
Set c = .Find("HEALTH", LookIn:=xlValues)
If Not c Is Nothing Then
'save first find
f = c.Address
Do ' loop until no more finds
InsertRows c
Set c = .FindNext(c.Offset(4, 0))
Loop While Not c Is Nothing And c.Address <> f
End If
End With

End Sub

' ##########################################
Sub InsertRows(rng As Range)
' inserts and updates rows to a given range

Dim i As Long

For i = 3 To 1 Step -1
rng.Offset(1, 0).EntireRow.Insert
rng.Offset(1, 0).Value = "Health group " & Chr(64 + i)
rng.Offset(1, 1).Value = rng.Offset(0, 1).Value
Next i

End Sub

osce
07-24-2006, 02:27 AM
Thank you very much fro your help. It is working now.

:beerchug: