concatenate loop to end of row

mak0316

New Member
Joined
May 26, 2015
Messages
9
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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Can you upload a workbook that has what you want it to look like when done? Just the concatenation part.
 
Upvote 0
Change the path and file name to suit.

Code:
[COLOR=darkblue]Sub[/COLOR] Patient_Records()
    
    [COLOR=darkblue]Dim[/COLOR] FF [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], strText [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], v [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], arrConcat() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strConcat [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    [COLOR=darkblue]Const[/COLOR] strDelimiter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR] = vbLf
    
    [COLOR=darkblue]ReDim[/COLOR] arrConcat(1 [COLOR=darkblue]To[/COLOR] 1, 1 [COLOR=darkblue]To[/COLOR] 1)
    
    strFile = [COLOR=#ff0000]ThisWorkbook.Path & "\Test.Txt"[/COLOR] [COLOR=green]'file path and name[/COLOR]
    
    FF = FreeFile()
    [COLOR=darkblue]Open[/COLOR] strFile [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Binary[/COLOR] [COLOR=darkblue]As[/COLOR] #FF
    strText = Space$(LOF(FF))
    [COLOR=darkblue]Get[/COLOR] #FF, , strText
    [COLOR=darkblue]Close[/COLOR] #FF
    
    v = Split(strText, vbLf)
    
    [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](v) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](v)
        [COLOR=darkblue]If[/COLOR] v(i) [COLOR=darkblue]Like[/COLOR] "*######-#####*" [COLOR=darkblue]Then[/COLOR]
            strConcat = Application.Trim(v(i))
        [COLOR=darkblue]ElseIf[/COLOR] v(i) [COLOR=darkblue]Like[/COLOR] "*COMPLETED*" [COLOR=darkblue]Or[/COLOR] v(i) [COLOR=darkblue]Like[/COLOR] "*Expires*" [COLOR=darkblue]Then[/COLOR]
            strConcat = strConcat & strDelimiter & Application.Trim(v(i))
            j = j + 1
            [COLOR=darkblue]ReDim[/COLOR] [COLOR=darkblue]Preserve[/COLOR] arrConcat(1 [COLOR=darkblue]To[/COLOR] 1, 1 To j)
            arrConcat(1, j) = strConcat
            strConcat = ""
            j = j + 1   [COLOR=green]'empty row between records[/COLOR]
        [COLOR=darkblue]ElseIf[/COLOR] strConcat <> "" [COLOR=darkblue]Then[/COLOR]
            strConcat = strConcat & strDelimiter & Application.Trim(v(i))
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] Worksheets.Add(After:=Sheets(Sheets.Count))
        .Cells.WrapText = [COLOR=darkblue]True[/COLOR]
        .Columns("A").ColumnWidth = 100
        .Columns("B:D").ColumnWidth = 18
        [COLOR=darkblue]With[/COLOR] .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 = [COLOR=darkblue]True[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        .Range("A2").Resize(j - 1, 1).Value = Application.Transpose(arrConcat)
        .Columns(1).AutoFit
        .Rows.AutoFit
        
        [COLOR=darkblue]With[/COLOR] .Range("A1:D1").Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]For[/COLOR] i = 2 To j [COLOR=darkblue]Step[/COLOR] 2
            [COLOR=darkblue]With[/COLOR] .Rows(i).Range("A1:D1").Borders
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]Next[/COLOR] i
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,203,468
Messages
6,055,599
Members
444,800
Latest member
KarenTheManager

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