• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Adding info if LCase(Target.Value) = (Excel 2003)

Excelnoub

Member
Good morning everyone,

I am trying to figure out a code that I have but to re-arrange for another column. I need, when the user selects a criteria in column X:X to add a row bellow. That I already have. I need it to also grab the information from another cell and add the information with a "/001" after the Text copied from that other cell.


Code:

______________________________________

If (Target, Range("X:X")) = LCase(Target.Value) = "termination n/a" Then

As an example I will take Row 5


If Cell M = Testing and If Cell X = termination n/a is selected then

Add 001 to Cell Q and

add the text from Cell M therefore "Testing" add /001 making Cell R to equal "Testing/001"

Then Clear Cell X.

_________________________________________


The following code is inserted:


_________________________________________

If Not Intersect(Target, Range("X:X")) Is Nothing Then

If Target.Cells.Count = 1 Then ' stops the code looping

If LCase(Trim(Target.Value)) = "termination wc" Then

Target.Offset(1).EntireRow.Insert

Cells(Target.Row + 1, 17).Value = "001"

Range("A" & Target.Row + 1).Resize(, 13).Value = Range("A" & Target.Row).Resize(, 13).Value

Range("W" & Target.Row).Resize(, 2).ClearContents

End If

End If

End If

_________________________________________


I am also using this code in the same sheet, that works like a charm. I just cant figure out the rest:


_________________________________________

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("L5:L1000")) Is Nothing Then

NumRows = Target.Value - 1

For R = 1 To NumRows

Target.Offset(1, 0).EntireRow.Insert

Next R

End If


If Not Intersect(Target, Range("L5:L1000")) Is Nothing Then


For I = 1 To Target ' stops the code looping

tmpArr = tmpArr & "," & I

Next I


With Target


With .Offset(, 1).Resize(.Value)


.NumberFormat = "000"

.Value = Application.Transpose(Split(Mid(tmpArr, 2), ","))

.Formula = "=A$" & .Row & "&""/""&TEXT(ROW()-" & .Row - 1 & ",""000""""/HS"""""")"

.Value = .Value

End With

.Offset(0, -11).Copy .Offset(0, -11).Resize(.Value)

.Offset(0, -10).Copy .Offset(0, -10).Resize(.Value)

.Offset(0, -9).Copy .Offset(0, -9).Resize(.Value)

.Offset(0, -8).Copy .Offset(0, -8).Resize(.Value)

.Offset(0, -7).Copy .Offset(0, -7).Resize(.Value)

.Offset(0, -6).Copy .Offset(0, -6).Resize(.Value)

.Offset(0, -5).Copy .Offset(0, -5).Resize(.Value)

.Offset(0, -4).Copy .Offset(0, -4).Resize(.Value)

.Offset(0, -3).Copy .Offset(0, -3).Resize(.Value)

.Offset(0, -2).Copy .Offset(0, -2).Resize(.Value)

.Offset(0, -1).Copy .Offset(0, -1).Resize(.Value)

.Offset(0, 0).Copy .Offset(0, 0).Resize(.Value)

End With

End If

_________________________________________


Please Help
 
Here is my full sheet code:


_________________________________________________


Sub Test()

MsgBox Application.WorksheetFunction.Match(Range("A5:A10000"), Worksheets("Contracts").Range("A5:A10000"))

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = True

Dim NewRwHt As Single

Dim cWdth As Single, MrgeWdth As Single

Dim c As Range, cc As Range

Dim ma As Range

Dim TCol As Long

Dim TRow As Long

Dim RptProjRowNum As Long


TRow = Target.Row

TCol = Target.Column


If TRow > 5 Or TRow < 1000 Then


If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("L5:L1000")) Is Nothing Then

NumRows = Target.Value - 1

For R = 1 To NumRows

Target.Offset(1, 0).EntireRow.Insert

Next R

End If


If Not Intersect(Target, Range("L5:L1000")) Is Nothing Then


For I = 1 To Target ' stops the code looping

tmpArr = tmpArr & "," & I

Next I


With Target


With .Offset(, 1).Resize(.Value)


.NumberFormat = "000"

.Value = Application.Transpose(Split(Mid(tmpArr, 2), ","))

.Formula = "=A$" & .Row & "&""/""&TEXT(ROW()-" & .Row - 1 & ",""000""""/HS"""""")"

.Value = .Value

End With

.Offset(0, -11).Copy .Offset(0, -11).Resize(.Value)

.Offset(0, -10).Copy .Offset(0, -10).Resize(.Value)

.Offset(0, -9).Copy .Offset(0, -9).Resize(.Value)

.Offset(0, -8).Copy .Offset(0, -8).Resize(.Value)

.Offset(0, -7).Copy .Offset(0, -7).Resize(.Value)

.Offset(0, -6).Copy .Offset(0, -6).Resize(.Value)

.Offset(0, -5).Copy .Offset(0, -5).Resize(.Value)

.Offset(0, -4).Copy .Offset(0, -4).Resize(.Value)

.Offset(0, -3).Copy .Offset(0, -3).Resize(.Value)

.Offset(0, -2).Copy .Offset(0, -2).Resize(.Value)

.Offset(0, -1).Copy .Offset(0, -1).Resize(.Value)

.Offset(0, 0).Copy .Offset(0, 0).Resize(.Value)

End With

End If


If Target.Column = 18 Then

Cells(Target.Row, "T").FormulaR1C1 = "=IF(RC16="""","""",RC16+365)"

End If


If Not Intersect(Target, Range("X:X")) Is Nothing And Target.Cells.Count = 1 Then

Application.EnableEvents = False


If LCase(Trim(Target.Value)) = "yes" Then

With Range("A" & Target.Row)

Sheets("Archives").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(, 18).Value = .Resize(, 18).Value

.Resize(, 19).ClearContents

End With

End If


If Not Intersect(Target, Range("X:X")) Is Nothing Then

If Target.Cells.Count = 1 Then ' stops the code looping

If LCase(Target.Value) = "termination n/a" Then

Cells(Target.Row, 17).Value = "001"

' ALSO copy the text in Cells(Target.Row, 13) then Paste it to Cells(Target.Row, 18)

' and add /001 after the text

Cells(Target.Row, 13).Copy Cells(Target.Row, 18)

Cells(Target.Row, 18) = Cells(Target.Row, 13) & "001"

Range("X" & Target.Row).ClearContents

End If

End If

End If

If Not Intersect(Target, Range("X:X")) Is Nothing Then

If Target.Cells.Count = 1 Then ' stops the code looping
r />If LCase(Target.Value) = "termination nc" Then

Cells(Target.Row, 17).Value = "001"

Range("X" & Target.Row).ClearContents

End If

End If

End If

If Not Intersect(Target, Range("X:X")) Is Nothing Then

If Target.Cells.Count = 1 Then ' stops the code looping

If LCase(Trim(Target.Value)) = "termination wc" Then

Target.Offset(1).EntireRow.Insert

Cells(Target.Row + 1, 17).Value = "001"

Range("A" & Target.Row + 1).Resize(, 13).Value = Range("A" & Target.Row).Resize(, 13).Value

Range("W" & Target.Row).Resize(, 2).ClearContents

End If

End If

End If


Application.EnableEvents = True

End If


End If

End Sub

_________________________________________________


Thank you in advanced.
 
Hi, Excelnoub!

I'd humbly suggest you to either paste your code examples embedded within backtics so as to keep it indented and easier to understand, or better indeed upload a sample file as indicated in second green sticky post at this forums main page.

Regards!
 
Back
Top