Copy Names and Create Script Using VBA

[drmingle]

Objective: to create a VBA auto-generated script from data elements within a series of cells

Data elements (Target Name starting at B1):

A B C
[TABLE="width: 398"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD]Target Name[/TD]
[TD]J RMC[/TD]
[TD]Pohnson LMC[/TD]
[/TR]
[TR]
[TD]Alias Names[/TD]
[TD]Johnson RMC[/TD]
[TD]Pohnson LMCs[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Johnson Rock Mine Corp[/TD]
[TD]Pohnson Lock Mine CoLp[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Johnson RM Corp[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]J RMC[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Johnson R Mine C[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I would like to take all columns that have data in them like the above with varying lengths and generate a script below (I will then copy/paste this later):

If [automfg]="J RMC" or [automfg]="Johnson RMC" or [automfg]="Johnson Rock Mine Corp" or [automfg]="Johnson RM Corp" or "J RMC" or [automfg]="Johnson R Mine C"
then "J RMC"
elseif [automfg]="Pohnson LMC" or [automfg]="Pohnson LMCs" or [automfg]="Pohnson Lock Mine CoLp"
then "Phonson LMC"
end

Thank you in advance for any help.

 

[RickXL]

Hi,

Depending on how critical spaces and line feeds are this should be close:

Sub CreateString()

    Dim i As Long, j As Long, lr As Long
    Dim strOut As String

    With ActiveSheet
        strOut = "if "
        For j = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            lr = .Cells(.Rows.Count, j).End(xlUp).Row
            For i = 1 To .Cells(.Rows.Count, j).End(xlUp).Row
                If (i = 1) And (j <> 2) Then strOut = strOut & vbLf & " elseif "
                strOut = strOut & "[autofmg]=""" & .Cells(i, j) & IIf(i = lr, """ then """ & .Cells(1, j) & """", """ or ")
            Next
        Next
        strOut = strOut & vbLf & " end"
        .Range("E7") = strOut
    End With

End Sub

 

[drmingle]

Wonderful!

Perfect solution...+1