Re: Excel; Join records question?

From: Dave Peterson (ec35720_at_netscape.com)
Date: 11/06/04 

Date: Sat, 06 Nov 2004 05:14:25 -0600

David's original code kept track of column A (the key column) and built a string
based on the data column (column B).

Since you want to keep 4 additional columns, the code needs to keep track of
them. Then it can paste them into the new work***. I used a variable named
columnAtoD to hold these values.

Option Explicit
Sub JoinCodes()
'David McRitchie http://www.mvps.org/dmcritchie/excel/excel.htm
' 2002-09-12
'and some slight modifications 2004-11-06
Dim wsSource As Work***
Dim wsNew As Work***
Dim xArg As String, xStr As String, nRow As Long
Dim cell As Range
Dim ColumnAtoDHolder As Variant
Set wsSource = Active***
Set wsNew = Worksheets.Add
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
  nRow = -1
  For Each cell In wsSource.Columns(5) _
       .SpecialCells(xlConstants)
    If nRow = -1 Then
       nRow = nRow + 1
       xArg = Trim(cell.Value)
       xStr = cell.Offset(0, 1).Value
       ColumnAtoDHolder = cell.Offset(0, -4).Resize(1, 4).Value
    ElseIf xArg = cell.Value Then
      If Trim(cell.Offset(0, 1)) <> "" Then _
        xStr = xStr & ", " & Trim(cell.Offset(0, 1))
    Else
       nRow = nRow + 1
       wsNew.Cells(nRow, 1).Resize(1, 4).Value _
        = Application.Index(ColumnAtoDHolder, 1, 0)
       wsNew.Cells(nRow, 5) = xArg
       wsNew.Cells(nRow, 6) = xStr
       xArg = Trim(cell.Value)
       xStr = Trim(cell.Offset(0, 1).Value)
    End If
  Next cell
  nRow = nRow + 1
  wsNew.Cells(nRow, 1).Resize(1, 4).Value _
        = Application.Index(ColumnAtoDHolder, 1, 0)
  wsNew.Cells(nRow, 5) = xArg
  wsNew.Cells(nRow, 6) = xStr
done:
   Cells.Select
   Cells.EntireColumn.AutoFit
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True 'place at end when debugged
   Application.DisplayAlerts = True
End Sub

tenshi wrote:
>
> Thanks David!
>
> You script "joincode.txt" seems to be working for me. In the actual
> data I will be using, I have 6 columns, where the first 4 are
> identical. The complete data looks as below example.
> Hope you will be able to help me out.
> Again thanks for your help.
>
> Regards,
> Moeller
>
> INPUT:
> A B C D E F
> Xxx West zzz TX 68319837810 CL
> Xxx West zzz TX 68319837810 WD
> Xxx West zzz TX 68319837810 WE
> Xxx West qqq CA 68320010300 CE
> Xxx West qqq CA 68320010300 CL
> Xxx West qqq CA 68320010300 TE
> Xxx West qqq AZ 68320011050 TE
> Xxx West qqq TX 68320011270 TE
> Xxx West aaa CA 68320011280 OT
> Xxx West aaa CA 68320011280 SH
> Xxx West aaa NV 68320012190 CE
> Xxx West zzz NV 68320012260 OT
> Xxx West zzz NV 68320012260 SH
>
> DESIRED OUTPUT:
> A B C D E F
> Xxx West zzz TX 68319837810 CL, WD, WE
> Xxx West qqq CA 68320010300 CE, CL, TE
> Xxx West qqq AZ 68320011050 TE
> Xxx West qqq TX 68320011270 TE
> Xxx West aaa CA 68320011280 OT, SH
> Xxx West aaa NV 68320012190 CE
> Xxx West zzz NV 68320012260 OT, SH
>
> On Sat, 6 Nov 2004 00:16:30 -0500, "David McRitchie"
> <dmcritchie@msn.com> wrote:
>
> >Joining Codes in Column B to a Product in Column A (#joining)
> > http://www.mvps.org/dmcritchie/excel/code/snakecol.htm#joining
> >
> >JOINCODE macro creates a new ***. Macro joins Column B
> >to a Product in Column A. Coding can be found at http://www.mvps.org/dmcritchie/excel/code/joincode.txt
> >
> >---
> >HTH,
> >David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
> >My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
> >Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
> >
> >"tenshi" <mm@mm.org> wrote in message news:7adoo01rdhjdibu7dgjj45p9uc2hnoighp@4ax.com...
> >> Hello,
> >>
> >> Can somebody please help me to get an output like the below.
> >> If COL A has two identical rows,but with a different value in COL B, I
> >> would like to have the value of COL B joined as shown in the below
> >> OUTPUT example.
> >>
> >>
> >> INPUT:
> >> A B
> >> 68319438890 DD
> >> 68319438890 TE
> >> 68319439020 TE
> >> 68319439060 FE
> >> 68319439080 TE
> >> 68319439100 TE
> >> 68319439190 OT
> >> 68319439190 SH
> >>
> >>
> >> DESIRED OUTPUT:
> >> A B
> >> 68319438890 DD, TE
> >> 68319439020 TE
> >> 68319439060 FE
> >> 68319439080 TE
> >> 68319439100 TE
> >> 68319439190 OT, SH
> >>
> >>
> >> Regards,
> >>
> >>
> > 

-- 
Dave Peterson
ec35720@netscape.com