VBA Wizard Needed - True / False Concatenate generated number in Specic column

L

LNG2013

Active Member
Joined
May 23, 2011
Messages
466
I use a web app to produce a survey. It gives me an output in a csv. The check box's output is True or False.

I need to create a VBA macro that looks at the specific columns, my columns change order, and if the column has a True statement it puts a specific number in Column Code1 based on the column that was true.

All of the numbers will need to be concatenated together in the column, each number is seperated by a space. If a column has a False statement, it does not put a number on Code1.

See the table below for an example layout.

ValueA1 if True = 1
ValueB1 if True = 2
ValueC1 if True = 3
ValueD1 if True = 4
ValueE1 if True = 5
ValueF1 if True = 6
ValueG1 if True = 7
False = no number in Code1 column.

<STYLE type=text/css>
table.tableizer-table {border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif; font-size: 12px;} .tableizer-table td {padding: 4px; margin: 3px; border: 1px solid #ccc;}
.tableizer-table th {background-color: #104E8B; color: #FFF; font-weight: bold;}
</STYLE>
<TABLE style="WIDTH: 713px; HEIGHT: 175px" class=tableizer-table>
<TBODY><TR class=tableizer-firstrow><TH>ValueA1</TH><TH>ValueB1</TH><TH>ValueC1</TH><TH>ValueD1</TH><TH>ValueE1</TH><TH>ValueF1</TH><TH>ValueG1</TH><TH>Code1</TH></TR><TR><TD>TRUE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>1 4 7</TD></TR><TR><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>3 5 7</TD></TR><TR><TD>TRUE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>1 2 5 </TD></TR><TR><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>TRUE</TD><TD>2 6 7</TD></TR><TR><TD>FALSE</TD><TD>FALSE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>TRUE</TD><TD>FALSE</TD><TD>4 6 </TD></TR>





</TABLE>

Let me say how awesome this forum is! Everyone has been emmensely helpful in helping me with my questions! It is really appreciated!:biggrin:
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Will need to know what the final data set will look like IMO.

Based on your initial example, it appeared your "solution" was concatenating the column numbers that had TRUE as a value..

I.E. [A=1, D=4, G=7]

Maybe that was a coincidence?

So are you looking to identify the column number containing TRUE? Or am I missing the point?
 
Upvote 0
It corresponds only to the title of the column, ValueA1 and not to the actual column letter eg AA.

So anytime a column has a true statement in it, it concatenates the value of that column to the code1 column. If they have a False statment they have no value and thus nothing to concatenate to the code1 column.


Here are the column titles and their values.
ValueA1 if True = 1
ValueB1 if True = 2
ValueC1 if True = 3
ValueD1 if True = 4
ValueE1 if True = 5
ValueF1 if True = 6
ValueG1 if True = 7
False = no number in Code1 column.
 
Upvote 0
LNG2013 said:
No the column order itself changes, and there is other data mixed in there... its a bit of mess but the final version gets weeded down by a sub that deletes the unneeded columns.
Click to expand...

Sorry for the additional questions, i just want to make sure understand exactly what you need it to do... You stated above the columns may change... So what if the data looked like this:

A1 B1 C1 D1 E1 F1 G1 H1 I1

And say row 1 looked like this
1 2 3 4 5 6 7 8 9
True, False, True, Extra Data, False, True, True, Extra Data, False

NOTE: There are 9 total columns in my example, but only 7 of them are of interest.

So if the above were the case would your desired result be:
a: 1 3 6 7

or

b: 1 3 5 6


The discrepancy I am trying to uncover is WHAT will the specific number in the formula result be referring to since you said the column order changes and there is extra data in the data set. Its relatively easy to loop through a range and return a concatenate code for the COL Numbers where TRUE resided, however its something totally different if you have to account for "extra data" fields that could be anywhere within the data set.

Also what is the range of the data set you want to evaluate, and what COL should the result be placed in?

IE.

Range A1:G10000 --> Results in Col H1:H10000
 
Last edited:
Upvote 0
No problem with the questions I appreciate the help in trying to work this out!

Question1/2:
The answer to your first question is B.

as the title headers could be in such a sporadic order as: ValueA1 Name1 ValueC1 LastName ValueE1 Address ValueB1 Zipcode ValueD1....

or another example of how messed up it can be:
<STYLE type=text/css>
table.tableizer-table {border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif; font-size: 12px;} .tableizer-table td {padding: 4px; margin: 3px; border: 1px solid #ccc;}
.tableizer-table th {background-color: #104E8B; color: #FFF; font-weight: bold;}
</STYLE>
<TABLE style="WIDTH: 1048px; HEIGHT: 174px" class=tableizer-table>
<TBODY><TR class=tableizer-firstrow><TH>ValueF1</TH><TH>Temp</TH><TH>ValueB1</TH><TH>ValueE1</TH><TH>Test</TH><TH>ValueG1</TH><TH>AMPM</TH><TH>Hour1</TH><TH>ValueD1</TH><TH>ValueA1</TH><TH>Code1</TH><TH>ValueC1</TH></TR><TR><TD>FALSE</TD><TD>43</TD><TD>FALSE</TD><TD>FALSE</TD><TD>1</TD><TD>TRUE</TD><TD>AM</TD><TD>1</TD><TD>TRUE</TD><TD>TRUE</TD><TD>1 4 7</TD><TD>FALSE</TD></TR><TR><TD>FALSE</TD><TD>65</TD><TD>FALSE</TD><TD>TRUE</TD><TD>2</TD><TD>TRUE</TD><TD>AM</TD><TD>3</TD><TD>FALSE</TD><TD>FALSE</TD><TD>3 5 7</TD><TD>TRUE</TD></TR><TR><TD>FALSE</TD><TD>33</TD><TD>TRUE</TD><TD>TRUE</TD><TD>1</TD><TD>FALSE</TD><TD>PM</TD><TD>6</TD><TD>FALSE</TD><TD>TRUE</TD><TD>1 2 5 </TD><TD>FALSE</TD></TR><TR><TD>TRUE</TD><TD>23</TD><TD>TRUE</TD><TD>FALSE</TD><TD>2</TD><TD>TRUE</TD><TD>PM</TD><TD>3</TD><TD>FALSE</TD><TD>FALSE</TD><TD>2 6 7</TD><TD>FALSE</TD></TR><TR><TD>TRUE</TD><TD>21</TD><TD>FALSE</TD><TD>FALSE</TD><TD>1</TD><TD>FALSE</TD><TD>AM</TD><TD>2</TD><TD>TRUE</TD><TD>FALSE</TD><TD>4 6 </TD><TD>FALSE</TD></TR>
</TABLE>


Each specified column, Those in whose text is changed to blue above, have a number specified to them. That number is the number that would be concatenated over to column code1 if it is True.

ValueA1 if True = 1
ValueB1 if True = 2
ValueC1 if True = 3
ValueD1 if True = 4
ValueE1 if True = 5
ValueF1 if True = 6
ValueG1 if True = 7
False = no number in Code1 column.


Question 3:
The range is difficult because the columns fluctuate so much, A1 of course is the start, currently columns go up to GH but it will most likely exceed this, the columns are the different data sets, and its very possible to have over 1000 data sets in a month.

Question 3:

All data will concatenate into column Code1.


Sthrncali said:
Sorry for the additional questions, i just want to make sure understand exactly what you need it to do... You stated above the columns may change... So what if the data looked like this:

A1 B1 C1 D1 E1 F1 G1 H1 I1

And say row 1 looked like this
1 2 3 4 5 6 7 8 9
True, False, True, Extra Data, False, True, True, Extra Data, False

NOTE: There are 9 total columns in my example, but only 7 of them are of interest.

So if the above were the case would your desired result be:
a: 1 3 6 7

or

b: 1 3 5 6


The discrepancy I am trying to uncover is WHAT will the specific number in the formula result be referring to since you said the column order changes and there is extra data in the data set. Its relatively easy to loop through a range and return a concatenate code for the COL Numbers where TRUE resided, however its something totally different if you have to account for "extra data" fields that could be anywhere within the data set.

Also what is the range of the data set you want to evaluate, and what COL should the result be placed in?

IE.

Range A1:G10000 --> Results in Col H1:H10000
Click to expand...
 
Upvote 0
Hello. Here's my stab at it:

Code: 
Sub foo()
Dim lr As Long, lc As Long, i As Long, j As Long, k As Long
Dim sNumber As String, nArray() As String
Dim c As Range

With Activesheet    
    lr = Last(1, .Cells)
    lc = Last(2, .Cells)
    For i = 1 To lr
        k = 0
        For j = 1 To lc
            If .Cells(i, j).Value = True Then
                k = k + 1
                ReDim Preserve nArray(1 To k)
                nArray(k) = j
            End If
        Next j
        sNumber = Join(nArray, " ")
        .Cells(i, lc +1).Value = sNumber
    Next i
End With
    

End Sub

Function Last(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function
 
Last edited:
Upvote 0
I think this will get the job done.

Let me know if you run into any problems with it...

Code: 
Sub CustomConcat()
 
Dim LC As Integer, LR As Integer
Dim Identifier As String
Dim A1 As String, B1 As String, C1 As String, D1 As String, E1 As String, F1 As String, G1 As String
Dim Code1 As Integer
 
LC = ActiveSheet.Range("XX1").End(xlToLeft).Column
LR = ActiveSheet.Range("A65536").End(xlUp).Row
 
For r = 1 To 1
For c = 1 To LC
If ActiveSheet.Cells(r, c).Value = "Code1" Then
Code1 = ActiveSheet.Cells(r, c).Column
End If
Next
Next
 
For r = 2 To LR
For c = 1 To LC
If ActiveSheet.Cells(r, c).Value = "True" Then
Identifier = ActiveSheet.Cells(1, c).Value
Select Case Identifier
 Case "ValueA1"
    A1 = "1 "
 Case "ValueB1"
    B1 = "2 "
 Case "ValueC1"
    C1 = "3 "
 Case "ValueD1"
    D1 = "4 "
 Case "ValueE1"
    E1 = "5 "
 Case "ValueF1"
    F1 = "6 "
 Case "ValueG1"
    G1 = "7"
End Select
 
End If
 
Next
 
ActiveSheet.Cells(r, Code1).Value = A1 & B1 & C1 & D1 & E1 & F1 & G1
 
A1 = ""
B1 = ""
C1 = ""
D1 = ""
E1 = ""
F1 = ""
G1 = ""
 
Next
 
End Sub
 
Upvote 0
Whoops...missed the "columns could be in any order" bit. Try this....it should be pretty quick because you're only looping through the 7 columns to check for a "True" rather than the entire sheet (where you have a lot of columns you may not be using). 10k rows took less than 2 seconds on my machine...:

Code: 
Option Explicit
Option Base 1
Sub foo2()
Dim output As Long, lc As Long, lr As Long, i As Long, t As Long, k As Long, w As Long
Dim r As Range
Dim j(7) As Long
Dim nArray() As String
Dim sNumber As String

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

With Sheet1
    lr = Last(1, .Cells)
    lc = Last(2, .Cells)
    
Set r = Range(.Cells(1, 1), .Cells(1, lc))

output = Find_Data("Code1", r, 2, xlWhole)

j(1) = Find_Data("ValueA1", r, 2, xlWhole)
j(2) = Find_Data("ValueB1", r, 2, xlWhole)
j(3) = Find_Data("ValueC1", r, 2, xlWhole)
j(4) = Find_Data("ValueD1", r, 2, xlWhole)
j(5) = Find_Data("ValueE1", r, 2, xlWhole)
j(6) = Find_Data("ValueF1", r, 2, xlWhole)
j(7) = Find_Data("ValueG1", r, 2, xlWhole)

For w = 2 To lr
    k = 0
    For i = LBound(j) To UBound(j)
        t = j(i)
        If .Cells(w, t).Value = "True" Then
            k = k + 1
            ReDim Preserve nArray(1 To k)
            nArray(k) = j(i)
        End If
    Next i
            sNumber = Join(nArray, " ")
            .Cells(w, output).Value = sNumber
            sNumber = ""
            Erase nArray
Next w
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
Function Last(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(what:="*", _
                        After:=rng.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(what:="*", _
                        After:=rng.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(what:="*", _
                       After:=rng.Cells(1), _
                       LookAt:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(what:="*", _
                        After:=rng.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function

Function Find_Data(what As String, rng As Range, how As Long, Optional LookAt As XlLookAt = xlPart)
' how = 1 returns row
' how = 2 returns column

Select Case how
        
    Case 1:
        On Error Resume Next
        Find_Data = rng.Find(what:=what, _
                        After:=rng.Cells(1), _
                        LookAt:=LookAt, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Find_Data = rng.Find(what:=what, _
                        After:=rng.Cells(1), _
                        LookAt:=LookAt, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0
End Select
End Function
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA code clean up
Replies
9
Views
583
mumps
mumps
E
  • Question Question
Adding a custom message.
Replies
1
Views
666
Micron
M
M
  • Question Question
Isolate a number in string specified to the same number of digit without an extra number attached to it
Replies
0
Views
320
Martin1978
M
S
  • Question Question
How to extract Start and End time for a true/false event from a data sheet using vba code?
2
Replies
11
Views
866
Syed Ahmad Ali Shah
S
E
  • Question Question
Create mails with table - standard header specific row
Replies
1
Views
1K
esben
E

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top