INSERT

[oleg_v]

HI

i need some help with a macro

i attached a sample file and i make the required action on "DIM_9"
in red and green i need the same thing will be done in the rest of dims


THANKS

[Bob Phillips]

Use conditional formatting with formulae of

=AND(LEFT(C3,3)="DIM",ISNUMBER(FIND("-",C3)))

for green, and

=LEFT(C3,3)="DIM"

for red

[macropod]

Hi oleg,

There is no code in the workbook, so no-one can see what you're trying to do or what the problem might be that you need help with. What are the rules that are supposed to control the colouring? For all I know, it might be something you could use conditional formatting for. In that case, you wouldn't need help with a macro.

[oleg_v]

Hi
i do not how to begin the code.
the rules are:
1) i column "c" find the word with "DIM" in it.
2) according to column "d" if cells value is numeric insert 2 rows above it in column "c" "dim"- runing number.
for example as you can see in the file between "DIM_9" and "DIM_10"
there are a few numbers in column "D" so what i need is to write according to rules in paragraph 2 from "DIM_9" TILL "DIM_10" dim_9_1,dim_9_2 and so on till it meet the ather dim

sorry for my English

Thanks

[macropod]

Duplicate post, sorry. Connection problems, I suppose.

[oleg_v]

please see my answer

[macropod]

Hi oleg,

Try:

Sub Test()
Application.ScreenUpdating = False
Dim i, j As Long, strTmp As String
With ActiveSheet
  For i = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    If Not IsEmpty(Cells(i, 4)) Then
      If IsNumeric(Cells(i, 4).Value) And InStr(Cells(i + 1, 3).Value, "DIM_") = 0 Then
        .Rows(i + 1).EntireRow.Insert
      End If
    End If
  Next
  For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
    If InStr(Cells(i, 3).Value, "DIM_") > 0 Then
      If InStr(Cells(i, 3).Value, "-") = 0 Then
        strTmp = Cells(i, 3).Value & "-"
        j = 1
      Else
        Cells(i, 3).Value = strTmp & j '***
        j = j + 1
      End If
    ElseIf IsEmpty(Cells(i, 3)) And Not IsEmpty(Cells(i - 1, 4)) Then
      Cells(i, 3).Value = strTmp & j
      j = j + 1
    End If
  Next
End With
Application.ScreenUpdating = True
End Sub

Note: With the addition of the line marked with *** to above code, if any minor numbers have been deleted or are out of order, new minor numbers will be allocated in the correct order.

[oleg_v]

hi
i am getting am error at this line:" ElseIf IsEmpty(Cells(i, 3)) And Not IsEmpty(Cells(i - 1, 4)) Then

[macropod]

Hi oleg,

Change:
For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
to:
For i = 2 To .Cells.SpecialCells(xlCellTypeLastCell).Row