Please, Head's Spinning - How to Concatanate This? Excel 07 VBA

[SirSchiz]

Any help is so much appreciated with this! My VBA Skills are offically Strained!

I have many worksheets that have a data structure like this:

Sample Data for testing:

X1
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
X1
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppp
X1
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppp
X1
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppp
X1
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp

BTW..All Data in all worksheets is in Column A

I need the the first found X1 to the Next Found X1 copied over to column D and combined(Concatenate right?) into 1 cell. Then repeated, but the next section would copy and combine to the next cell available in column D each section separated by a empty cell until all sections are complete. Then Next worksheet. The code I have so far copies only the first found section and copies, but very poorly combines into one cell.

My Sad Code:

Sub FindIt()

Dim Term As String
Dim Var As Range
Dim NxWsht As Worksheet
Dim WkBk As Workbook

    Term = "X1"
    Set Var = Range("A:A").Find(What:=Term, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Set WkBk = ActiveWorkbook
    
For Each NxWsht In WkBk.Sheets
    ActiveSheet.Range(Var, Var.End(xlUp)).Select
        With Selection
            .Copy
            .Range("D:D").PasteSpecial xlValues
        End With
            Set rng = Selection
            Set cel = Cells.Value
            For Each cel In rng
            x = x & cel.Value
            Next
            ActiveSheet.Range("D:D").Value = x
    
    Set Var = Range("A:A").FindNext([A1])

Next NxWsht

End Sub

 

[SirSchiz]

AlphaFrog,
That looks perfect! I wonder what I'm doing wrong then? Hmmm.... Let me see, most likely I'm having a brain dead moment! I have been working on 3 different macro for my company for 2 weeks now, and this was the last leg of it! So, as you can imagine, going from very little VBA skills, to little VBA skills has made my brain sore. =)

 

[SirSchiz]

Ahhh! Good points Rick. There very well maybe leading and trailing spaces. I trust your postings, I've seen them on the forums. I will revisit it to see, like AlphaFrog's re-post, if I'm the culprit, which most likely I am. Thanks for your efforts.

 

[SirSchiz]

Guys,

I tried to read through the sticky on how to post screen shots. Can anyone clear it up for me?

 

[Rick Rothstein]

That looks perfect! I wonder what I'm doing wrong then?

Just so you know, the output from my posted code is the same as AlphaFrog showed in his last posting. Perhaps if you posted a copy of your workbook somewhere so we could see your actual data/setup, then maybe we could resolve the problem for you more quickly. I don't think you can attach files to replies in this forum (at least if you can, then I do not know how); however, you can post it online using one of these free posting websites...

MediaFire: http://www.mediafire.com
FileFactory: http://www.filefactory.com
FileSavr: http://www.filesavr.com
FileDropper: http://www.filedropper.com
RapidShare: http://www.rapidshare.com
Box: http://www.box.net/files

And then post the URL they give you for the file back here.

If you are reluctant to make your workbook so widely available, you can send a copy directly to me and I will see if I can spot what might be going wrong. My email address is rickDOTnewsATverizonDOTnet (just replace the upper case letters with the symbols they spell out).

 

[SirSchiz]

All,

I now know why AlphaFrog's and Rick's code would not run. For some reason unknown to me, both macros would not run within the same Macro workbook as the other 2 Macros I run before this one. Once I add a Module into a new workbook that contains the data I posted, then ran each Macro separately for testing, 1 from AlphaFrog, the other from Rick, they both work perfectly! Why? I have no idea, but I can work with this for certain.

 

[cgcamal]

cgcamal,

Your's is it! I just realized that yours is doing just what I'm looking for. The formatting was off a bit. I will play with it
to see if I can get each cell to wrap text. Thank You!

Hi SirSchiz,

I didn't include the option to write each block of the concatenated values separated by an empty cell, this time is included.

Sub FindIt()
Dim SectionsRow()
Dim Term As String, s As Integer
Dim Var As Integer, TermCount As Integer, i As Integer
Dim NxWsht As Worksheet, WkBk As Workbook

Application.ScreenUpdating = False
    Term = "X1"
     'Set WkBk = ActiveWorkbook
    
For s = 1 To Sheets.Count
    With Sheets(s)
        TermCount = WorksheetFunction.CountIf(.Range("A:A"), Term)
        Var = .Range("A65000").End(xlUp).Row
        .Cells(Var + 1, 1) = Term
    
        ReDim SectionsRow(1 To TermCount + 1)
    
        SectionsRow(TermCount + 1) = Var + 1
    
        For i = TermCount To 1 Step -1
            Var = .Range("A:A").Find(What:=Term, After:=.Range("A" & Var), LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
    
            SectionsRow(i) = Var
        Next

        For i = LBound(SectionsRow) To UBound(SectionsRow) - 1
            For j = SectionsRow(i) + 1 To SectionsRow(i + 1) - 1
                .Cells(2 * (i - 1) + 1, 4) = .Cells(2 * (i - 1) + 1, 4) & .Cells(j, 1)
            Next j
        Next i
       
    .Cells(SectionsRow(TermCount + 1), 1).ClearContents

    End With
Next s

Application.ScreenUpdating = True
End Sub

Hope this helps,

Regards.