Announcement

Collapse
No announcement yet.

concatenate two cell values with VBA

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • concatenate two cell values with VBA

    Hi,
    how can I concatenate the values of two (or eventually more, i.e. a Range) of Excel cells using VBA, also using a criteria, described below?
    The background criteria for how many cell values in a row should be concatenated and exported in a new column, is, if a cell in a column has a background colouring.

    Hope that I explained the situation convenient enough, any questions, please ask.

    Cheers,
    Juergen

  • #2
    Re: concatenate two cell values with VBA

    Here's one example. Not sure if it's anything like waht you are after.
    Code:
    Sub ColourName()
    Dim c As Range, ColourName As String, ConCat As String
    For Each c In Range("A1:A3")
        Select Case c.Interior.ColorIndex
            Case 4:     ColourName = "Light Green"
            Case 5:     ColourName = "Blue"
            Case 7:     ColourName = "Pink"
            Case 10:    ColourName = "Green"
            Case 40:    ColourName = "Tan"
        End Select
        c.Offset(0, 1) = ColourName
        If c.Interior.ColorIndex > 0 Then Range("D2") = Range("D2") & ColourName
    Next c
    End Sub
    Best Regards,
    Tom
    ---------------------------
    Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

    Comment


    • #3
      Re: concatenate two cell values with VBA

      Hi,
      I enclosed an example Workbook.
      There, I have several rows, each with a header.

      In column M (comment type), I want to extract the background colour name, if a cell in a row is coloured.
      A UDF which can display the background colour name of a cell can be found within the following thread:
      Code:
      http://www.ozgrid.com/VBA/ReturnCellColor.htm
      In column N (comment text), I want to display all cell values, which have been coloured with a background. Sometimes there are more cells in a row, then all the coloured cell values should be concatedated.
      E.g. for row 15, there should be the concatenated values of all yellow cells standing in the column N, best separated with some kind of character:
      'nu_DMP1_E0048_Scont.oaT_oDMP1_gamma isoform2_3241_sheep_ZDY_15-May-98_Contig'

      The value 'yellow' should be displayed in column M, for row 15.

      Another example, row 10: there should be displayed 'yellow' in column M (comment type), and '1058' in column N (comment text).


      cheers
      Juergen
      Attached Files

      Comment


      • #4
        Re: concatenate two cell values with VBA

        Try the following (in the attached). It also puts the colorindex number in column L since your table did not include all of the colors used. (The code assumes that only one background color is used in a given row. (Note I had to remove a few of your data rows to keep the file small enough to post.)
        Code:
        Sub Fill_L_M_N()
            Dim c As Range, col As Integer, ColourName As String, ConCat As String, ColorNum As Integer
            For Each c In Range(Cells(5, 1), Cells(Rows.Count, 1).End(xlUp))
                ConCat = ""
                ColourName = ""
                For col = 0 To 11
                    If c.Offset(0, col).Interior.ColorIndex > 0 Then
                        ColorNum = c.Offset(0, col).Interior.ColorIndex
                        Select Case c.Offset(0, col).Interior.ColorIndex
                        Case 4:     ColourName = "Light Green"
                        Case 5:     ColourName = "Blue"
                        Case 6:     ColourName = "Yellow"
                        Case 7:     ColourName = "Pink"
                        Case 8:     ColourName = "Medium Blue"
                        Case 10:    ColourName = "Green"
                        Case 40:    ColourName = "Tan"
                        End Select
                        If Len(c.Offset(0, col)) > 0 Then
                            If Len(ConCat) > 0 Then ConCat = ConCat & "_" & c.Offset(0, col)
                            If Len(ConCat) < 1 Then ConCat = c.Offset(0, col)
                        End If
                    End If
                Next col
                c.Offset(0, 12) = ColourName
                c.Offset(0, 13) = ConCat
                c.Offset(0, 11) = ColorNum
            Next c
        Columns("L:N").Columns.AutoFit
        Cells(1, 1).Select
        End Sub
        Attached Files
        Best Regards,
        Tom
        ---------------------------
        Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

        Comment


        • #5
          Re: concatenate two cell values with VBA

          Hi Thomas,
          thanks for your code, it works fine.
          only one background color is used in a given row
          I found that in the next worksheet there are several (maximum three) background colours being used in a given row.

          I modified your code, adding colours.
          Is it possible to modify your code to look for more than one colour in each row, and write two new columns, containing comment type, i.e. the colour name and comment text, i.e. the (concatenated) cell values? So, including the colour index colum, there would be nine newly created columns, for each of the maximum of three possible comments.

          Cheers
          Juergen
          Attached Files
          Last edited by juergenkemeter; December 19th, 2005, 07:27. Reason: Adding modified code to example workbook

          Comment


          • #6
            Re: concatenate two cell values with VBA

            Originally posted by juergenkemeter
            Is it possible to modify your code to look for more than one colour in each row, and write two new columns, containing comment type, i.e. the colour name and comment text, i.e. the (concatenated) cell values? So, including the colour index colum, there would be nine newly created columns, for each of the maximum of three possible comments.
            Sorry for the delay. Wasn't able to spend time online yesterday.
            What you ask should be very doable. I'll try to post some code later today after I get some time to work on it.
            Best Regards,
            Tom
            ---------------------------
            Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

            Comment


            • #7
              Re: concatenate two cell values with VBA

              Today is turning out to be busier than I had expected. It may be tomorrow (USAA time) before I can get time to play.

              But I also realized I need to ask one question. Should the comment field differ for each color? That is, before I thought we were concatenating all cells in the regardless of the individual cell's background color. For the multicolor situation did you want just the cells that match in color in a given color's comment field? If not, does the comment field really need to be repeated for each color? If the comment should be color specific, what happens (with regard to the comments) with cells that have no color background?
              Best Regards,
              Tom
              ---------------------------
              Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

              Comment


              • #8
                Re: concatenate two cell values with VBA

                Hi,
                thx for your help so far.
                Perhaps it is possible to have a variable for checking if a colour has already been used?

                The comment type and comment text columns should differ for each colour.
                Yes, it would be good if only the cells that match in colour would be concatenated in value, and colour name into the two new columns.
                The worksheet has maximum FOUR different background colours in use.

                Jürgen
                Attached Files
                Last edited by juergenkemeter; December 20th, 2005, 06:39. Reason: enclosed example

                Comment


                • #9
                  Re: concatenate two cell values with VBA

                  See if the attached does what you need. It uses the following code.
                  Remove the
                  Code:
                  Range(xy.Offset(0, 12), xy.Offset(0, 14)).Interior.ColorIndex = CI1
                  lines from the "Secect case Cnt" portionof the code if you do not want the output cells color coded to match the source cells.
                  Code:
                  Sub ParseColors()
                      Dim xy As Range, col As Integer, Cnt As Integer
                      Dim CI1 As Integer, CI2 As Integer, CI3 As Integer, CI4 As Integer
                      Dim ColourName As String
                      
                      Range(Cells(2, 14), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 25)).Clear  'Clear columns N:Y of previous entries
                      For Each xy In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) 'select data origin rows
                          Cnt = 1
                          CI1 = 0
                          CI2 = 0
                          CI3 = 0
                          CI4 = 0
                          For col = 0 To 11 'number of data origin rows, here: cols B to M (offsets from column 2 of 0 to 11)
                              If xy.Offset(0, col).Interior.ColorIndex > 0 Then
                                  Select Case xy.Offset(0, col).Interior.ColorIndex
                                      Case CI1
                                          xy.Offset(0, 14) = xy.Offset(0, 14) & "_" & xy.Offset(0, col)
                                      Case CI2
                                          xy.Offset(0, 17) = xy.Offset(0, 17) & "_" & xy.Offset(0, col)
                                      Case CI3
                                          xy.Offset(0, 20) = xy.Offset(0, 20) & "_" & xy.Offset(0, col)
                                      Case CI4
                                          xy.Offset(0, 23) = xy.Offset(0, 23) & "_" & xy.Offset(0, col)
                                      Case Else
                                          Select Case xy.Offset(0, col).Interior.ColorIndex
                                              Case 1:     ColourName = "Black"
                                              Case 2:     ColourName = "White"
                                              Case 3:     ColourName = "Red"
                                              Case 4:     ColourName = "Bright Green"
                                              Case 5:     ColourName = "Blue"
                                              Case 6:     ColourName = "Yellow"
                                              Case 7:     ColourName = "Pink"
                                              Case 8:     ColourName = "Turqoise"
                                              Case 9:     ColourName = "Dark Red"
                                              Case 10:    ColourName = "Green"
                                              Case 11:    ColourName = "Dark Blue"
                                              Case 12:    ColourName = "Dark Yellow"
                                              Case 13:    ColourName = "Violet"
                                              Case 14:    ColourName = "Teal"
                                              Case 15:    ColourName = "Gray-25%"
                                              Case 16:    ColourName = "Gray-50%"
                                              Case 33:    ColourName = "Sky Blue"
                                              Case 34:    ColourName = "Light Turqoise"
                                              Case 35:    ColourName = "Light Green"
                                              Case 36:    ColourName = "Light Yellow"
                                              Case 37:    ColourName = "Pale Blue"
                                              Case 38:    ColourName = "Rose"
                                              Case 39:    ColourName = "Lavendar"
                                              Case 40:    ColourName = "Tan"
                                              Case 41:    ColourName = "Light Blue"
                                              Case 42:    ColourName = "Aqua"
                                              Case 42:    ColourName = "Aqua"
                                              Case 43:    ColourName = "Lime"
                                              Case 44:    ColourName = "Gold"
                                              Case 45:    ColourName = "Light Orange"
                                              Case 46:    ColourName = "Orange"
                                              Case 47:    ColourName = "Blue-Gray"
                                              Case 48:    ColourName = "Gray-40%"
                                              Case 49:    ColourName = "Dark Teal"
                                              Case 50:    ColourName = "Sea Green"
                                              Case 51:    ColourName = "Dark Green"
                                              Case 52:    ColourName = "Olive Green"
                                              Case 53:    ColourName = "Brown"
                                              Case 54:    ColourName = "Plum"
                                              Case 55:    ColourName = "Indigo"
                                              Case 55:    ColourName = "Tan"
                                              Case 56:    ColourName = "Gray-80%"
                                              Case Else:  ColourName = "No name Listed"
                                          End Select
                                          Select Case Cnt
                                              Case 1
                                                  CI1 = xy.Offset(0, col).Interior.ColorIndex
                                                  xy.Offset(0, 12) = CI1
                                                  xy.Offset(0, 13) = ColourName
                                                  xy.Offset(0, 14) = xy.Offset(0, col).Value
                                                  Range(xy.Offset(0, 12), xy.Offset(0, 14)).Interior.ColorIndex = CI1
                                              Case 2
                                                  CI2 = xy.Offset(0, col).Interior.ColorIndex
                                                  xy.Offset(0, 15) = CI2
                                                  xy.Offset(0, 16) = ColourName
                                                  xy.Offset(0, 17) = xy.Offset(0, col).Value
                                                  Range(xy.Offset(0, 15), xy.Offset(0, 17)).Interior.ColorIndex = CI2
                                              Case 3
                                                  CI3 = xy.Offset(0, col).Interior.ColorIndex
                                                  xy.Offset(0, 18) = CI3
                                                  xy.Offset(0, 19) = ColourName
                                                  xy.Offset(0, 20) = xy.Offset(0, col).Value
                                                  Range(xy.Offset(0, 18), xy.Offset(0, 20)).Interior.ColorIndex = CI3
                                              Case 4
                                                  CI4 = xy.Offset(0, col).Interior.ColorIndex
                                                  xy.Offset(0, 21) = CI4
                                                  xy.Offset(0, 22) = ColourName
                                                  xy.Offset(0, 23) = xy.Offset(0, col).Value
                                                  Range(xy.Offset(0, 21), xy.Offset(0, 23)).Interior.ColorIndex = CI4
                                          End Select
                                          Cnt = Cnt + 1
                                  End Select
                              End If
                          Next col
                      Next xy
                         
                      Columns("N:Y").Columns.AutoFit 'Format column widths
                      Cells(1, 1).Select
                  End Sub
                  Attached Files
                  Last edited by thomach; December 21st, 2005, 02:07. Reason: close code tag
                  Best Regards,
                  Tom
                  ---------------------------
                  Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

                  Comment


                  • #10
                    Re: concatenate two cell values with VBA

                    P.S. I forgot to mention that in the code above I alphabetized your ColorIndex Select Case entries. Noted one duplicate that I deleted, and also that you have two conflicting entries for ColorIndex 55.

                    Add a new (blank) sheet to your workbook and run the following macro while on a blank sheet to get your full colorindex map.
                    Code:
                    Sub ShowColorIndex()
                    Dim r As Integer
                    If WorksheetFunction.CountA(Range("A1:B64")) > 1 Then
                        MsgBox "Change to blank sheet ... Running this macro will overwrite data in column A and/or B."
                        Exit Sub
                    End If
                    For r = 1 To 56
                        Cells(r, 1) = r
                        Cells(r, 2).Interior.ColorIndex = r
                    Next r
                    End Sub
                    Last edited by thomach; December 21st, 2005, 03:01. Reason: typo
                    Best Regards,
                    Tom
                    ---------------------------
                    Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

                    Comment


                    • #11
                      Re: concatenate two cell values with VBA

                      Hi!
                      The code works fine. What do I have to change if I want to include column A into the origin dataset? I'm getting a little confused with the many offsets.

                      And if you could write one or two sentences about how your code proncipally works, so that I can learn from it, thanks.

                      Cheers,
                      Jurgen
                      Last edited by juergenkemeter; December 21st, 2005, 06:02.

                      Comment


                      • #12
                        Re: concatenate two cell values with VBA

                        To include column A, change this line
                        Code:
                        For col = 0 To 11 'number of data origin rows, here: cols B to M (offsets from column 2 of 0 to 11)
                        to
                        Code:
                        For col = -1 to 11 'number of data origin rows, here: cols A to M (offsets from column B of -1 to 11)
                        In a nutshell, the code loops though the columns in each row (2 to the last row). Everytime it finds a cell with an interior color set, it assigns the colrindex number to a variable (CI1 to CI4). It decides which variable t use based on teh value of Cnt (which is reset to 1 each time a new row is examined and is incremented by 1 within a row each time a cell filled with a new-to that-row color is found. The first time it finds a particular color in a row the Case Else fires because the CIx varaible has not yet been set. The second or hire time that colorindex is found in a row, the Case CIx that matches it fires.

                        The offsets simply match the "march" accross the row and fill the appropriate column with data from the current cell. If the current cell has no color backgoound set, its colorindex is less than zero (some negative error number) so the first IF statement in the col loop skips everything in the col loop and moves on to check th cell in th next column.

                        CIx variables are reset to 0 at the start of the next xy (next row) loop.
                        Last edited by thomach; December 21st, 2005, 08:33.
                        Best Regards,
                        Tom
                        ---------------------------
                        Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

                        Comment


                        • #13
                          weird output for colour index and comment

                          Hi,
                          In my enclosed example, I want to start your code output in column 'AN'.
                          For a few colours the output looks fine, but for some rows, the column output is weird, as the colour index is concatenated with a part of the comment text column.

                          Juergen
                          Attached Files
                          Last edited by juergenkemeter; December 21st, 2005, 09:47. Reason: improved description

                          Comment


                          • #14
                            Re: weird output for colour index and comment

                            The problem was in this part of the code.
                            Code:
                                            Select Case xy.Offset(0, col).Interior.ColorIndex
                                                Case CI1
                                                    xy.Offset(0, 40) = xy.Offset(0, 40) & "_" & xy.Offset(0, col)
                                                Case CI2
                                                    xy.Offset(0, 43) = xy.Offset(0, 43) & "_" & xy.Offset(0, col)
                                                Case CI3
                                                    xy.Offset(0, 46) = xy.Offset(0, 46) & "_" & xy.Offset(0, col)
                                                Case CI4
                                                    xy.Offset(0, 49) = xy.Offset(0, 49) & "_" & xy.Offset(0, col)
                                                Case Else
                            The above is correct. You were writing the comment to the first cell in each triple rather than the 3rd cell. I just incremented the offsets by two. You have the offsets correct in the other parts of the code, I believe.

                            In the attached I had to delete a few rows to keep the file size small enough to attach, so I modified the code to include rows 2 to the last used row.
                            Attached Files
                            Best Regards,
                            Tom
                            ---------------------------
                            Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

                            Comment


                            • #15
                              Re: concatenate two cell values with VBA

                              I wasn't thinking abopt you perhaps needing/wanting to change the output column. I should have coded like this to start with. Just change the "AN" to the first output column you wnat to use in the 5th line where "tof" is calculated.
                              Code:
                              Sub ParseColors()
                                  Dim xy As Range, col As Integer, Cnt As Integer
                                  Dim CI1 As Integer, CI2 As Integer, CI3 As Integer, CI4 As Integer
                                  Dim ColourName As String, tof As Integer
                                  
                                  tof = Columns("AN").Column - 2   'Offset for first target (output) column
                              
                                  Range(Cells(2, tof+2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, tof + 13)).Clear 'Clear previous entries
                                  For Each xy In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) 'select data origin rows
                                      Cnt = 1
                                      CI1 = 0
                                      CI2 = 0
                                      CI3 = 0
                                      CI4 = 0
                                      For col = -1 To 11 'number of data origin rows, here: cols A to M (offsets from column 2 of 0 to 11)
                                          If xy.Offset(0, col).Interior.ColorIndex > 0 Then
                                              Select Case xy.Offset(0, col).Interior.ColorIndex
                                                  Case CI1
                                                      xy.Offset(0, tof + 2) = xy.Offset(0, tof + 2) & "_" & xy.Offset(0, col)
                                                  Case CI2
                                                      xy.Offset(0, tof + 5) = xy.Offset(0, tof + 5) & "_" & xy.Offset(0, col)
                                                  Case CI3
                                                      xy.Offset(0, tof + 8) = xy.Offset(0, tof + 8) & "_" & xy.Offset(0, col)
                                                  Case CI4
                                                      xy.Offset(0, tof + 11) = xy.Offset(0, tof + 11) & "_" & xy.Offset(0, col)
                                                  Case Else
                                                      Select Case xy.Offset(0, col).Interior.ColorIndex
                                                          Case 1:     ColourName = "Black"
                                                          Case 2:     ColourName = "White"
                                                          Case 3:     ColourName = "Red"
                                                          Case 4:     ColourName = "Bright Green"
                                                          Case 5:     ColourName = "Blue"
                                                          Case 6:     ColourName = "Yellow"
                                                          Case 7:     ColourName = "Pink"
                                                          Case 8:     ColourName = "Turqoise"
                                                          Case 9:     ColourName = "Dark Red"
                                                          Case 10:    ColourName = "Green"
                                                          Case 11:    ColourName = "Dark Blue"
                                                          Case 12:    ColourName = "Dark Yellow"
                                                          Case 13:    ColourName = "Violet"
                                                          Case 14:    ColourName = "Teal"
                                                          Case 15:    ColourName = "Gray-25%"
                                                          Case 16:    ColourName = "Gray-50%"
                                                          Case 33:    ColourName = "Sky Blue"
                                                          Case 34:    ColourName = "Light Turqoise"
                                                          Case 35:    ColourName = "Light Green"
                                                          Case 36:    ColourName = "Light Yellow"
                                                          Case 37:    ColourName = "Pale Blue"
                                                          Case 38:    ColourName = "Rose"
                                                          Case 39:    ColourName = "Lavendar"
                                                          Case 40:    ColourName = "Tan"
                                                          Case 41:    ColourName = "Light Blue"
                                                          Case 42:    ColourName = "Aqua"
                                                          Case 42:    ColourName = "Aqua"
                                                          Case 43:    ColourName = "Lime"
                                                          Case 44:    ColourName = "Gold"
                                                          Case 45:    ColourName = "Light Orange"
                                                          Case 46:    ColourName = "Orange"
                                                          Case 47:    ColourName = "Blue-Gray"
                                                          Case 48:    ColourName = "Gray-40%"
                                                          Case 49:    ColourName = "Dark Teal"
                                                          Case 50:    ColourName = "Sea Green"
                                                          Case 51:    ColourName = "Dark Green"
                                                          Case 52:    ColourName = "Olive Green"
                                                          Case 53:    ColourName = "Brown"
                                                          Case 54:    ColourName = "Plum"
                                                          Case 55:    ColourName = "Indigo"
                                                          Case 55:    ColourName = "Tan"
                                                          Case 56:    ColourName = "Gray-80%"
                                                          Case Else:  ColourName = "No name Listed"
                                                      End Select
                                                      Select Case Cnt
                                                          Case 1
                                                              CI1 = xy.Offset(0, col).Interior.ColorIndex
                                                              xy.Offset(0, tof) = CI1
                                                              xy.Offset(0, tof + 1) = ColourName
                                                              xy.Offset(0, tof + 2) = xy.Offset(0, col).Value
                                                              Range(xy.Offset(0, tof), xy.Offset(0, tof + 2)).Interior.ColorIndex = CI1
                                                          Case 2
                                                              CI2 = xy.Offset(0, col).Interior.ColorIndex
                                                              xy.Offset(0, tof + 3) = CI2
                                                              xy.Offset(0, tof + 4) = ColourName
                                                              xy.Offset(0, tof + 5) = xy.Offset(0, col).Value
                                                              Range(xy.Offset(0, tof + 3), xy.Offset(0, tof + 5)).Interior.ColorIndex = CI2
                                                          Case 3
                                                              CI3 = xy.Offset(0, col).Interior.ColorIndex
                                                              xy.Offset(0, tof + 6) = CI3
                                                              xy.Offset(0, tof + 7) = ColourName
                                                              xy.Offset(0, tof + 8) = xy.Offset(0, col).Value
                                                              Range(xy.Offset(0, tof + 6), xy.Offset(0, tof + 8)).Interior.ColorIndex = CI3
                                                          Case 4
                                                              CI4 = xy.Offset(0, col).Interior.ColorIndex
                                                              xy.Offset(0, tof + 9) = CI4
                                                              xy.Offset(0, tof + 10) = ColourName
                                                              xy.Offset(0, tof + 11) = xy.Offset(0, col).Value
                                                              Range(xy.Offset(0, tof + 9), xy.Offset(0, tof + 11)).Interior.ColorIndex = CI4
                                                      End Select
                                                      Cnt = Cnt + 1
                                              End Select
                                          End If
                                      Next col
                                  Next xy
                                     
                                  Range(Columns(tof + 2), Columns(tof + 13)).Columns.AutoFit 'Format column widths
                                  Cells(1, 1).Select
                              End Sub
                              Attached Files
                              Last edited by thomach; December 22nd, 2005, 00:04. Reason: Fix some missed hardcoded column numbers
                              Best Regards,
                              Tom
                              ---------------------------
                              Please help Oz share knowledge among all users by posting your questions in a public forum rather than using a Private Message.

                              Comment

                              Working...
                              X