Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 15

Thread: concatenate loop to end of row

  1. #1
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question concatenate loop to end of row

    Hello I am pretty new to VBA programing and I am stuck on a Concatenate problem.

    I have a .txt document (outputted from a XML program) that I have to upload into excel and manually format to meet our reporting standards (outside reporting agency) anyway, I have set up a Sub to separate the data into useful chunks
    Code:
    Public Sub ProcessData()
    Const TEST_COLUMN As String = "A"
    Dim i As Long
    Dim iLastRow As Long
    
    With ActiveSheet
    
    iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
    For i = iLastRow To 1 Step -1
    If .Evaluate("SUMPRODUCT(COUNTIF(" & .Cells(i, TEST_COLUMN).Address & _
    ",{""*COMPLETED*"",""*Expires*""}))") > 0 Then
    Rows(i).Offset(1).EntireRow.Insert xlShiftDown
    End If
    Next i
    
    End With
    End Sub
    But now I am trying to Concatenate the data from the 4 to 5 cell "chunks" to 1 cell that contains all the data. for example

    Colum A colum A (on separete sheet)
    Partial data 1 Complete data 1, 2, 3, & 4
    Partial data 2 Complete data 1, 2, 3, & 4
    Partial data 3
    Partial data 4
    Blank row
    Partial data 1 ect

    I am trying to make a looping Concatenate function but I cannot get it to work. I correctly concatenates the first set of data but then stops at the blank row. Is there a way to have it continue to loop?

    Here is what I have so far
    Code:
    Public Function ColConc(CellRef As Range, Delimiter As String)
    
    Dim LoopVar As Long
    Dim StartRow As Long
    Dim EndRow As Long
    Dim Concat As String
    Dim Col As Long
    With Cells.SpecialCells(xlCellTypeConstants)
    Col = CellRef.Column
    StartRow = CellRef.Row
    EndRow = CellRef.End(xlDown).Row
    Concat = ""
    For LoopVar = StartRow To EndRow
    Concat = Concat & Cells(LoopVar, Col).Value
    If LoopVar <> EndRow Then Concat = Concat & Delimiter
    LoopVar
    End With
    ColConc = Concat
    End Function
    I thought the LoopVAr would have the sub continue on to the next set but it does not so I am lost.
    thanks for any help in advance

  2. #2
    MrExcel MVP AlphaFrog's Avatar
    Join Date
    Sep 2009
    Posts
    15,875
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    5 Thread(s)

    Default Re: concatenate loop to end of row

    I barely follow what you're doing. But if there are blank cells within the column, then the .End(xlDown) method doesn't necessarily return the end row. It may return the last row down to the 1st blank cell.
    EndRow = CellRef.End(xlDown).Row

    Perhaps try this...
    EndRow = CellRef.Parent.Cells(Rows.Count, CellRef.Column).End(xlUp).Row
    Paste your Excel data to the forum...
    MrExcel HTML Maker or Excel Jeanie

    How to post your vba code
    [CODE]your VBA code here[/CODE]
    The # button in the forum's editor will apply CODE tags around your selected text.

  3. #3
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: concatenate loop to end of row

    Thank you for your help. Your Changes now allow me to Concatenate all the data but it ends up all in one cell (up to the 255 limit).

    I need to figure out how to have the macro concatenate the cells by criteria (which is what i posted it just doesn’t loop to the next set), put the result on another sheet (which I already have a sub for) then loop to the next criteria so that the results end up as
    A
    1| concatenate 1
    2| concatenate 2
    ect.

    I do not know if this is possible with VBA but I am looking for something to reduce the amount of man hours spent on this task.

    As for what I am doing I have to take a .txt file that has raw patient data and put into an excel spreadsheet, then I have to format all the data into a readable format where each patient is separate from the other. What I was doing previously was copy/past into excel, use my insert row macro to separate each patient, then manually concatenate the 4 to 5 cells worth of patient data into a single cell. After all that I could use a border/layout macro to make everything look nice for the reporting agency, which we have to report to weekly. we average 700 patients a week so I was looking for something to do the concatenate work for me as I have to separate around 5000 cells worth of data. I have tried to just import the data from the .txt but the format come out terrible, I tried to copy/paste over a premade background but since some of the data takes up 4 cells and some takes up 5 I have to fiddle with it every time. I am sure there is a way to simplify the process and that is what I am looking for.

  4. #4
    MrExcel MVP AlphaFrog's Avatar
    Join Date
    Sep 2009
    Posts
    15,875
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    5 Thread(s)

    Default Re: concatenate loop to end of row

    Where is the code that calls the function ColConc? Can you show that code?

    Does "*COMPLETED*" and "*Expires*" denote the start and end of a patient record?

    Do you have a example text file (scrubbed of any sensitive data) with say a dozen records that you could upload to a file share site? Then post the link here?
    Paste your Excel data to the forum...
    MrExcel HTML Maker or Excel Jeanie

    How to post your vba code
    [CODE]your VBA code here[/CODE]
    The # button in the forum's editor will apply CODE tags around your selected text.

  5. #5
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: concatenate loop to end of row

    I have not written the code to call the function i was just using it in the formula Bar to see if it would work before i wrote a call sub for it. As i said i am pretty new to vba so i am still learning to call functions from vba.

    Thanks for your help so far though

    The txt file is in the link below scrubed of all personal data.
    https://www.dropbox.com/s/6na6lgazsltiheh/Test.txt?dl=0

  6. #6
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: concatenate loop to end of row

    I forgot to mention that the *completed* and *expires* are the two ways the data can end. I coundnt figure out what to use as a start as it is an log number that always changes

  7. #7
    MrExcel MVP AlphaFrog's Avatar
    Join Date
    Sep 2009
    Posts
    15,875
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    5 Thread(s)

    Default Re: concatenate loop to end of row

    Can you upload a workbook that has what you want it to look like when done? Just the concatenation part.
    Paste your Excel data to the forum...
    MrExcel HTML Maker or Excel Jeanie

    How to post your vba code
    [CODE]your VBA code here[/CODE]
    The # button in the forum's editor will apply CODE tags around your selected text.

  8. #8
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: concatenate loop to end of row

    Here is what i would like it to look like

  9. #9
    New Member
    Join Date
    May 2015
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: concatenate loop to end of row


  10. #10
    MrExcel MVP AlphaFrog's Avatar
    Join Date
    Sep 2009
    Posts
    15,875
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    5 Thread(s)

    Default Re: concatenate loop to end of row

    Change the path and file name to suit.

    Code:
    Sub Patient_Records()
        
        Dim FF As Long, strText As String, strFile As String
        Dim i As Long, v As Variant
        Dim j As Long, arrConcat() As String, strConcat As String
        
        Const strDelimiter As String = vbLf
        
        ReDim arrConcat(1 To 1, 1 To 1)
        
        strFile = ThisWorkbook.Path & "\Test.Txt" 'file path and name
        
        FF = FreeFile()
        Open strFile For Binary As #FF
        strText = Space$(LOF(FF))
        Get #FF, , strText
        Close #FF
        
        v = Split(strText, vbLf)
        
        For i = LBound(v) To UBound(v)
            If v(i) Like "*######-#####*" Then
                strConcat = Application.Trim(v(i))
            ElseIf v(i) Like "*COMPLETED*" Or v(i) Like "*Expires*" Then
                strConcat = strConcat & strDelimiter & Application.Trim(v(i))
                j = j + 1
                ReDim Preserve arrConcat(1 To 1, 1 To j)
                arrConcat(1, j) = strConcat
                strConcat = ""
                j = j + 1   'empty row between records
            ElseIf strConcat <> "" Then
                strConcat = strConcat & strDelimiter & Application.Trim(v(i))
            End If
        Next i
        
        Application.ScreenUpdating = False
        With Worksheets.Add(After:=Sheets(Sheets.Count))
            .Cells.WrapText = True
            .Columns("A").ColumnWidth = 100
            .Columns("B:D").ColumnWidth = 18
            With .Range("A1:D1")
                .Value = Array("Patient" & vbLf & "Information", _
                               "STATUS/DATE" & vbLf & "COMPLETED", _
                               "AFTER ORDER" & vbLf & "DAYS(>30 DAYS" & vbLf & "REQUIRE ACTIONS)", _
                               "PATIENT" & vbLf & "NOTIFIED", _
                               "COMMENTS")
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
            End With
            .Range("A2").Resize(j - 1, 1).Value = Application.Transpose(arrConcat)
            .Columns(1).AutoFit
            .Rows.AutoFit
            
            With .Range("A1:D1").Borders
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            For i = 2 To j Step 2
                With .Rows(i).Range("A1:D1").Borders
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
            Next i
        End With
        Application.ScreenUpdating = True
        
    End Sub
    Paste your Excel data to the forum...
    MrExcel HTML Maker or Excel Jeanie

    How to post your vba code
    [CODE]your VBA code here[/CODE]
    The # button in the forum's editor will apply CODE tags around your selected text.

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •