Add multiple columns into one cell

[shre0047]

In tab1, I have a table with the end user will complete:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Type[/TD]
[TD]Check 1[/TD]
[TD]Check 2[/TD]
[TD]Check 3[/TD]
[TD]Check 4[/TD]
[TD]Check 5[/TD]
[TD]Check 6[/TD]
[TD]Check 7[/TD]
[TD]Check 8[/TD]
[TD]Check 9[/TD]
[TD]Combined Check[/TD]
[/TR]
[TR]
[TD]Type1[/TD]
[TD]L[/TD]
[TD][/TD]
[TD][/TD]
[TD]M[/TD]
[TD][/TD]
[TD]L[/TD]
[TD][/TD]
[TD]H[/TD]
[TD][/TD]
[TD]H[/TD]
[/TR]
[TR]
[TD]Type2[/TD]
[TD][/TD]
[TD]M[/TD]
[TD][/TD]
[TD][/TD]
[TD]L[/TD]
[TD][/TD]
[TD]M[/TD]
[TD][/TD]
[TD]M[/TD]
[TD]M[/TD]
[/TR]
</tbody>[/TABLE]


In tab2, Column B is what I'm attempting to get as an end result. I can't determine if a nested if statement formula or macro would be most efficient option for this.
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Type[/TD]
[TD]Merge All Used Checks[/TD]
[TD]Combined Check[/TD]
[/TR]
[TR]
[TD]Type1[/TD]
[TD]Check 1: Low

Check 4: Medium

Check 6: Low

Check 8: High[/TD]
[TD]High[/TD]
[/TR]
[TR]
[TD]Type2[/TD]
[TD]Check 2: Medium

Check 5: Low

Check 7: Medium

Check 9: Medium[/TD]
[TD]Medium[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG11Jul40
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Ray = ActiveSheet.Cells(1).CurrentRegion
ReDim nray(1 To UBound(Ray, 1), 1 To 3)
nray(1, 1) = "Type": nray(1, 2) = "Merge all Used Checks": nray(1, 3) = "Combined Check"
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
c = c + 1
nray(c, 1) = Ray(n, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Ray(n, Ac)
                [COLOR="Navy"]Case[/COLOR] "L": Txt = "Low"
                [COLOR="Navy"]Case[/COLOR] "M": Txt = "Medium"
                [COLOR="Navy"]Case[/COLOR] "H": Txt = "High"
            [COLOR="Navy"]End[/COLOR] Select
           [COLOR="Navy"]If[/COLOR] Ac < UBound(Ray, 2) [COLOR="Navy"]Then[/COLOR]
                nray(c, 2) = nray(c, 2) & Ray(1, Ac) & " : " & Txt & vbLf
           [COLOR="Navy"]Else[/COLOR]
                nray(c, 3) = Ray(n, Ac)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
   .Value = nray
    .Columns.AutoFit
    '[COLOR="Green"][B].Rows.AutoFit[/B][/COLOR]
    .Borders.Weight = 2
 [COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[shre0047]

I am getting the error "subscript out of range"

Here is the simplified version of the excel file for reference:
https://drive.google.com/open?id=1f1u-tzdNLglK_pmGhLPEtqXbgJf9fNdy

 

[MickG]

Try this on sheet "End User" for results on "sheet2"
For some reason, on your googlefile sheet you appear to have chevrons (down pointing arrows)in columns "H to W".
I don't know if they are meant to be there.??
When the file is down loaded they do not appear in the sheet (but the expected letters Do!!), but the "Currentregion" function counts them, and therefore the final result shows them as blank rows.
I have removed them from the data before running the code.

[COLOR="Navy"]Sub[/COLOR] MG11Jul18
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
Ray = ActiveSheet.Cells(1).CurrentRegion

ReDim nray(1 To UBound(Ray, 1), 1 To 3)
nray(1, 1) = "Type": nray(1, 2) = "Merge all Used Checks": nray(1, 3) = "Combined Check"
c = 1
[COLOR="Navy"]For[/COLOR] n = 3 To UBound(Ray, 1)
c = c + 1
nray(c, 1) = Ray(n, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 8 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Ray(n, Ac)
                [COLOR="Navy"]Case[/COLOR] "L": Txt = "Low"
                [COLOR="Navy"]Case[/COLOR] "M": Txt = "Medium"
                [COLOR="Navy"]Case[/COLOR] "H": Txt = "High"
            [COLOR="Navy"]End[/COLOR] Select
           [COLOR="Navy"]If[/COLOR] Ac < UBound(Ray, 2) [COLOR="Navy"]Then[/COLOR]
                nray(c, 2) = nray(c, 2) & Ray(2, Ac) & " : " & Txt & vbLf
           [COLOR="Navy"]Else[/COLOR]
                nray(c, 3) = Txt
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
   .Value = nray
   .Columns.AutoFit
   .Borders.Weight = 2
 [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[shre0047]

For all the cells within H:W in 'End User' tab, end users will be selecting blank, L, M, or H from a dropdown list. Does this make it not possible to run this macro then?

 

[MickG]

You will have to try it.
When I tried without clearing the (Cheron cells) the code still worked, just added more Bordered cells in Results.
Try removing this line in code

   .Borders.Weight = 2

 

[shre0047]

Sorry for the simple question, but even without the drop-down list, I get the same error in the file. I am in 'End User' tab and attempt to run the macro, do I need to highlight all the rows prior to running the macro? I

 

[MickG]

Sorry, I did not realize they were validation cells.
I've added a commandButton and sheet2 to sheet "End User", and modified the code to only use lines that have values in column "A".
Try this:-
https://app.box.com/s/c0j7iuy1uc9ljw5rxoqbbcf48tw6s4yb

 

[shre0047]

Awesome thank you! Is there a way to make 'Sheet2' the same as 'Upload?' For "Merge All Used Checks" column, I am hoping to include the code you already included, but also include the value from 'End User'!B3 (this will change for each row).

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Merge all Used Check[/TD]
[/TR]
[TR]
[TD]='End User'!B3

Check1 : Medium
Check9 : High
Check14 : Low
[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try adding the line below in red:-

c = c + 1
nray(c, 1) = Ray(n, 1)
[B][COLOR=#ff0000]nray(c, 2) = Ray(n, 2) & vbLf[/COLOR][/B]
[B][COLOR=#ff0000][/COLOR][/B]