VBA help with grouping multiple rows into a single row automatically

[paladine]

I'm trying to write a code that would help me automate the process of combining multiple rows into a single row through the use of VBA. I have several hundreds of grouped data that needs to be put in their own individual rows. The code I currently have with the help of online search allows me to select the range of data that I want and select the location that I want to put it in. This combines all the selected range of data and put all of them in order into a single line.

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">

[COLOR=#00008B]Sub[/COLOR] TransposeSpecial() [COLOR=#00008B]Dim[/COLOR] lMaxRows [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Long[/COLOR] [COLOR=#808080]'max rows in the sheet[/COLOR] 
[COLOR=#00008B]Dim[/COLOR] lThisRow [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Long[/COLOR] [COLOR=#808080]'row being processed[/COLOR] 
[COLOR=#00008B]Dim[/COLOR] iMaxCol [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR] [COLOR=#808080]'max used column in the row being processed[/COLOR] 
[COLOR=#00008B]Dim[/COLOR] Counter [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR] [COLOR=#808080]' counter for seperate If loop[/COLOR] 
lMaxRows = Cells(Rows.Count, [COLOR=#800000]"A"[/COLOR]).[COLOR=#00008B]End[/COLOR](xlUp).Row 
lThisRow = [COLOR=#800000]1[/COLOR] [COLOR=#808080]'start from row 1[/COLOR] 
Counter = [COLOR=#800000]1[/COLOR] 
[COLOR=#00008B]Do[/COLOR] [COLOR=#00008B]While[/COLOR] lThisRow < lMaxRows 
iMaxCol = Cells(lThisRow, Columns.Count).[COLOR=#00008B]End[/COLOR](xlToLeft).Column 
[COLOR=#00008B]If[/COLOR] (iMaxCol > [COLOR=#800000]1[/COLOR]) 
[COLOR=#00008B]Then[/COLOR] [COLOR=#00008B]Call[/COLOR] TransformOneRow 
[COLOR=#00008B]End[/COLOR] [COLOR=#00008B]If
[/COLOR]lThisRow = lThisRow + [COLOR=#800000]1
[/COLOR][COLOR=#00008B]Loop
[/COLOR] [COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub[/COLOR] 

[COLOR=#00008B]Sub[/COLOR] TransformOneRow()
 [COLOR=#00008B]Dim[/COLOR] InputRng [COLOR=#00008B]As[/COLOR] Range, OutRng [COLOR=#00008B]As[/COLOR] Range
 xTitleId = [COLOR=#800000]"Transform"[/COLOR] 
[COLOR=#00008B]Set[/COLOR] InputRng = Application.Selection
 [COLOR=#00008B]Set[/COLOR] InputRng = Application.InputBox([COLOR=#800000]"Ranges to be transform :"[/COLOR], xTitleId, InputRng.Address, Type:=[COLOR=#800000]8[/COLOR])
 [COLOR=#00008B]Set[/COLOR] OutRng = Application.InputBox([COLOR=#800000]"Paste to (single cell):"[/COLOR], xTitleId, Type:=[COLOR=#800000]8[/COLOR]) 
Application.ScreenUpdating = [COLOR=#800000]False[/COLOR] 
xRows = InputRng.Rows.Count 
xCols = InputRng.Columns.Coun
t [COLOR=#00008B]For[/COLOR] i = [COLOR=#800000]1[/COLOR] [COLOR=#00008B]To[/COLOR] xRows
 InputRng.Rows(i).Copy OutRng 
[COLOR=#00008B]Set[/COLOR] OutRng = OutRng.Offset([COLOR=#800000]0[/COLOR], xCols + [COLOR=#800000]0[/COLOR]) 
[COLOR=#00008B]Next[/COLOR] 
Application.ScreenUpdating = [COLOR=#800000]True
[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub[/COLOR]

</code>I don't know how to write it so that it would automatically select the data range that I need and place it where I want it to be repeatedly for a large amount of data. Another problem I'm encountering that I don't know how to write is to make it detect empty rows so that it would skip to the next data cluster.![The photo shows the data clusters that I want to put in one row for each grouping][1] based on the image I would like to put rows 1-4 together into one line as a group.
imgur: the simple image sharer

 

[Roderick_E]

The key is what is called a "unique identifier" or "common reference". This could be a SKU number or an account number or something. something each of these individual rows have in common. With that, you could loop through your list, ignoring blanks and build a one-row result for each unique id.

 

[paladine]

So going by the data, that I included in the Imgur file, I should be using "CM7" as a unique identifier. I don't know if it's possible to just use a partial of a cell since it also includes a unique number. only the CM7 remains constant. If I were to use a unique ID, what line of coding would I use to call it, and how would I ignore blanks? Thanks for the quick reply.

 

[Roderick_E]

Unfortunately I can't see your image examples, but the unique id (UID) need not be singular (only in CM7), if could be duplicated on several rows:

Example below shows Item# as UID. We could loop and find out that Item# 12345 total count = 20. I'd need to understand how your data is structured.

Item#	Count	Date
12345	5	08/21/14
78910	8	08/15/14
12345	12	08/14/14
12345	3	08/21/14

<TBODY>
</TBODY>

 

[paladine]

imgur: the simple image sharer That's the test data that I need to convert, as you can see each section has it's own particular data that needs to be put in one line. Is there any type of coding that you can help me out with? I found another code that puts the data into columns, and goes down the list I believe, but I need it in rows. Unfortunately I'm not very good with coding, and can't tell what part of the code I would need to change.

Sub TransposeSpecial()
Dim lMaxRows As Long 'max rows in the sheet
Dim lThisRow As Long 'row being processed
Dim iMaxCol As Integer 'max used column in the row being processed


    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
      
    lThisRow = 1 'start from row 1
      
    Do While lThisRow < lMaxRows
          
        iMaxCol = Cells(lThisRow, Columns.Count).End(xlToLeft).Column
          
        If (iMaxCol > 1) Then
            Rows(lThisRow + 1 & ":" & lThisRow + iMaxCol - 1).Insert
            Range(Cells(lThisRow, 2), Cells(lThisRow, iMaxCol)).Copy
            Range("H" & lThisRow + 1).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range(Cells(lThisRow, 2), Cells(lThisRow, iMaxCol)).Clear
            lThisRow = lThisRow + iMaxCol - 1
            lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
        End If
          
        lThisRow = lThisRow + 1
    Loop
End Sub

if you can't see the imgur link I'll try to put this into this thread

CM7-CI1027	CF-HR	Q443 #3(LN4L/LM4L)FP	7	2	C Mount	BOX44#
						CHIP PULSE	0.218K	20C	0.26	8.88	1.01	13.05	676.48			AA1408140928
						CM PULSE Chip Face DOWN (WITH WIRE)	0.212K	20C	0.23	9.16	1.05	12.66	862.29	FP:6.175		AA1408151017
						CM CW (No lense)	0.212K	20C	0.36	10.88	0.60	11.74	265.71	FP:6.193		AA1408151138
CM7-CI1028	CF-HR	Q443 #5(LM6L)FP	7	3	C Mount	BOX44#
						CHIP PULSE	0.155K	20C	0.40	9.46	1.71	12.94	930.71			AA1408131629
						CM PULSE Chip Face DOWN (WITH WIRE)	0.150K	20C	0.36	8.91	1.81	13.07	1269.34	FP:6.197		AA1408151023
						CM CW (No lense)	0.150K	20C	0.51	10.60	0.80	11.23	284.91	FP:6.334		AA1408151130

<tbody>
</tbody>

 

[Roderick_E]

My works firewall will not allow me to access the image link. The formatting of what you pasted in doesn't help

Let's see if we can do it this way.

1)How do you know to copy rows 1-4 and not rows 1-8? What determines the grouping?
2) Will the headers be fixed for the new grouping?

 

[paladine]

My apologies Roderick, I forgot to take into account firewalls for certain companies. As for format it is exactly like the one I posted. Each spacing would denote that it is in its own column. I'm not too sure how to post tables onto this forum correctly. I'm trying to find a way so that it will group (1-4) (1-8) etc by a *blank row* between the groups of data.
I'm not too sure if there is a macro or subroutine that allows the program to skip a blank row and tell it to start a new grouping.

I'm assuming a "If Then" statement can be used to tell it what to do when it encounters a blank space. From what I have, I'm thinking I can either find a way to copy paste each line and then delete.( And find some way to tell it to point at the new group) or find a way to (concatenate? Transpose?) the data, and find a way to point it at the new group. At this point since the data is inconsistent with the amount of lines the database has, I find it difficult to write a code that would accommodate the difference in rows. The columns still remain the same.

After the data is put into one row it should look similar to :

CM7-CI1027

CF-HR

Q443 #3(LN4L/LM4L)FP

7

2

C Mount

BOX44#

CHIP PULSE

0.218K

20C

0.26

8.88

1.01

13.05

676.48

AA1408140928

CM PULSE Chip Face DOWN (WITH WIRE)

0.212K

20C

0.23

9.16

1.05

12.66

862.29

FP:6.175

AA1408151017

CM CW (No lense)

0.212K

20C

0.36

10.88

0.60

11.74

265.71

FP:6.193

AA1408151138

<tbody>
</tbody>

as opposed to the original:

Device #

Chip type

Width (mm)

Length (mm)

Package

Comment

Resistance

Temperature( C)

Ith (A@CW)

Vth (V@CW)

Isat (A@CW)

Vsat (V@CW)

Psat (mW@CW)

l (mm)

l (cm-1)

Test ID

CM7-CI1027

CF-HR

Q443 #3(LN4L/LM4L)FP

7

2

C Mount

BOX44#

CHIP PULSE

0.218K

20C

0.26

8.88

1.01

13.05

676.48

AA1408140928

CM PULSE Chip Face DOWN (WITH WIRE)

0.212K

20C

0.23

9.16

1.05

12.66

862.29

FP:6.175

AA1408151017

CM CW (No lense)

0.212K

20C

0.36

10.88

0.60

11.74

265.71

FP:6.193

AA1408151138

CM7-CI1028

CF-HR

Q443 #5(LM6L)FP

7

3

C Mount

BOX44#

CHIP PULSE

0.155K

20C

0.40

9.46

1.71

12.94

930.71

AA1408131629

CM PULSE Chip Face DOWN (WITH WIRE)

0.150K

20C

0.36

8.91

1.81

13.07

1269.34

FP:6.197

AA1408151023

CM CW (No lense)

0.150K

20C

0.51

10.60

0.80

11.23

284.91

FP:6.334

AA1408151130

<tbody>
</tbody>

Sorry about not having headers before. But In the case of the headers, they would need to be modified since we are doing a reformat of the data we have before.

 

[Roderick_E]

We're getting there. So your modified one line format will have duplicated headers correct? For example, the sample you gave you would have 4 columns that have the header of "Comment", containing in order, these 3 things:

1) BOX44#
2) CHIP PULSE
3) CM PULSE Chip Face DOWN (WITH WIRE)
4) CM CW (No lense)

Is this correct?

 

[paladine]

We're getting there. So your modified one line format will have duplicated headers correct? For example, the sample you gave you would have 4 columns that have the header of "Comment", containing in order, these 3 things:

1) BOX44#
2) CHIP PULSE
3) CM PULSE Chip Face DOWN (WITH WIRE)
4) CM CW (No lense)

Is this correct?

That is correct for the most part. I say most part because I stated before, that it's not always just those 4 under comment in any particular order. So I wouldn't say order, but most of the data contains those 4 data points although they have some differences in some of the data points. so sorting it by that might be more difficult. Yes there would be duplicate headers once they are put into a single line format, since each one under the comment header would have their individual duplicate headers.

I was hoping to be able to write find/write a program that would be able to use the special paste function to place it into a single line. Once it detects an empty row with a CheckIfEmpty and if it's true skip to the next line, where the next group of data is.