Apply macro to entire column, need help on macro structure too. (VBA)

[Nihilist]

I am using this code to run a macro everytime a cell in column H changes.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Call DefMacro
End If
End Sub

The macro I am trying to use is supposed to make cells in column 'I' change in regards to column H and output a statement in the respective 'I' cell. (as in, if H20 = "t2", then I = "statement).

 Sub DefMacro()
Range("I2").Formula = "=IF(H1="T1","COBRE EXPUESTO EN VENAS",IF(H1="T2","CONDUCTORES INVERTIDOS",IF(H1="T3","ORIFICIO TAPADO EN TABLILLA",IF(H1="T4","PORO EN SOLDADURA",IF(H1="T5","SELLADOR FALTANTE EN TABLILLA",IF(H1="T6","EXCESO DE FLUX EN SOLDADURA",IF(H1="T7","EXCESO DE SELLADOR",IF(H1="T8","FALTA DE SOLDADURA",IF(H1="T9","HILILLOS DAÑADOS",IF(H1="T10","JAULA DE PAJARO",IF(H1="T11","ORIFICIO TAPADO CON SELLADOR",IF(H1="T12","PORO EN PASTA",IF(H1="T13","PORO EN SOLDADURA",IF(H1="T14","SELLADOR FALTANTE",IF(H1="T15","SOLDADURA ALTA",IF(H1="T16","SOLDADURA CORTA",IF(H1="T17","SOLDADURA MALFORMADA",IF(H1="R1","CINTA DE ROTOR DAÑADA",IF(H1="R2","CINTA DE ROTOR DESPRENDIDA",IF(H1="R3","CINTA DE ROTOR CORTA (ALTURA)",IF(H1="R4","CUBIERTA METALICA FUERA DE SPEC",IF(H1="R5","FALTA DE PASTA EN MAGNETO",IF(H1="R6","FLECHA DAÑADA",IF(H1="R7","FLECHA CON REBABA",IF(H1="R8","MAGNETO AGRIETADO",IF(H1="R9","MAGNETO DAÑADO (LIJADO)",IF(H1="R10","MAGNETO MAQUINADO FUERA DE SPEC",IF(H1="R11","MAGNETO QUEBRADO"," & _
"IF(H1="R12","POLARIDAD",IF(H1="R13","PORO EN CINTA DE ROTOR","cero"))))))))))))))))))))))))))))))"
Range("I2", "I" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
End Sub

But, as you can see, the formula I am using is way too long and the code gives me an error (I actually need more statements). To be honest I am not very good at VBA and I don't know how to make it work.

The original code I used to help myself was this:

 Sub DefMacro()
Range("I2").Formula = "=$J3+1"
Range("I2", "I" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
End Sub

Which actually works, it adds 1 to every cell in 'I' that isn't empty.

Could any of you guys help me with either:

• Change the formula to a function (select case, etc)?
• Make the formula work with some kind of line break or something?
• Tell me if 'H1' will make the formula not work with each H cell by row as I intend it to and if I should change it to something more general?
• Provide another method to achieve the results or any other suggestion?

Thank you very much. ^^

 

[Joe4]

Welcome to the Board!

If you are only running this when a value in column H is changed, do you really need it to run against every row in column I, or just the row that was updated?

 

[Joe4]

Here is updated code and a function that will work whenever you add something to column H, it will update column I of the same row.
I did not list all your conditions. I will leave it to you to add the rest of them in there. It is pretty easy, they should follow the same pattern as you see:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        Target.Offset(0, 1) = Def(Target)
    End If
End Sub


Function Def(rng As Range) As String
    Select Case rng.Value
        Case "T1"
            Def = "COBRE EXPUESTO EN VENAS"
        Case "T2"
            Def = "CONDUCTORES INVERTIDOS"
        Case "T3"
            Def = "ORIFICIO TAPADO EN TABLILLA"
        Case "T4"
            Def = "PORO EN SOLDADURA"
        Case "T5"
            Def = "SELLADOR FALTANTE EN TABLILLA"
        Case "T6"
            Def = "EXCESO DE FLUX EN SOLDADURA"
        Case "T7"
            Def = "EXCESO DE SELLADOR"
        Case "T8"
            Def = "FALTA DE SOLDADURA"
        Case "T9"
            Def = "HILILLOS DAÑADOS"
        Case "T10"
            Def = "JAULA DE PAJARO"
        Case "T11"
            Def = "ORIFICIO TAPADO CON SELLADOR"
        Case "T12"
            Def = "PORO EN PASTA"
'       KEEP ENTERING THE REST OF YOUR OPTIONS HERE
'       ...
'       WHAT TO RETURN IF NO MATCH
        Case Else
            Def = "NOT FOUND!"
    End Select
End Function

 

[Nihilist]

Here is updated code and a function that will work whenever you add something to column H, it will update column I of the same row.
I did not list all your conditions. I will leave it to you to add the rest of them in there. It is pretty easy, they should follow the same pattern as you see:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        Target.Offset(0, 1) = Def(Target)
    End If
End Sub


Function Def(rng As Range) As String
    Select Case rng.Value
        Case "T1"
            Def = "COBRE EXPUESTO EN VENAS"
        Case "T2"
            Def = "CONDUCTORES INVERTIDOS"
        Case "T3"
            Def = "ORIFICIO TAPADO EN TABLILLA"
        Case "T4"
            Def = "PORO EN SOLDADURA"
        Case "T5"
            Def = "SELLADOR FALTANTE EN TABLILLA"
        Case "T6"
            Def = "EXCESO DE FLUX EN SOLDADURA"
        Case "T7"
            Def = "EXCESO DE SELLADOR"
        Case "T8"
            Def = "FALTA DE SOLDADURA"
        Case "T9"
            Def = "HILILLOS DAÑADOS"
        Case "T10"
            Def = "JAULA DE PAJARO"
        Case "T11"
            Def = "ORIFICIO TAPADO CON SELLADOR"
        Case "T12"
            Def = "PORO EN PASTA"
'       KEEP ENTERING THE REST OF YOUR OPTIONS HERE
'       ...
'       WHAT TO RETURN IF NO MATCH
        Case Else
            Def = "NOT FOUND!"
    End Select
End Function

This is precisely what I was looking for! It worked wonders!

I was already tired of having like 20 cells with embedded formulas in each row to be able to make the program work.

Thank you!!

 

[Joe4]

You are welcome.
Glad I was able to help!