Combining rows of data

[bydganwil]

I have a set of data that looks like this:

	Q1	Q2	Q3	Q4	Q5	Q6	Q7	Q8	Q9	Q10
Target 1	Y	Y	Y	Y
Target 1					Y	Y	Y
Target 1								Y	Y	Y
Target 2								Y	Y	Y
Target 2					Y	Y	Y
Target 2	Y	Y	Y	Y
Target 3					Y	Y	Y
Target 3	Y	Y	Y	Y
Target 3								Y	Y	Y

<TBODY>
</TBODY>

And I need it to look like this please:

Many thanks in advance!!

	Q1	Q2	Q3	Q4	Q5	Q6	Q7	Q8	Q9	Q10
Target 1	Y	Y	Y	Y	Y	Y	Y	Y	Y	Y
Target 2	Y	Y	Y	Y	Y	Y	Y	Y	Y	Y
Target 3	Y	Y	Y	Y	Y	Y	Y	Y	Y	Y

<TBODY>
</TBODY>

 

[hurgadion]

Hi,
let Your Data be in A1:K10, then try to run a following code:

Sub abstract()
Dim a&, i&, j&, k&

a = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & a).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "M1"), Unique:=True

For i = 2 To Cells(Rows.Count, "M").End(xlUp).Row
    For j = 2 To a
       If Cells(j, 1).Value = Cells(i, "M").Value Then
          For k = 2 To 11
             If Cells(j, k).Value <> "" Then
                Cells(i, k + 12).Value = Cells(j, k).Value
             End If
          Next k
       End If
    Next j
Next i
End Sub

Best regards.

 

[patel45]

Sub a()
r = 3
numcol = 11
Do While Cells(r, 1) <> ""
  If Cells(r, 1) = Cells(r - 1, 1) Then
    For c = 2 To numcol
      If Cells(r - 1, c) = "" Then Cells(r - 1, c) = Cells(r, c)
    Next
    Rows(r).Delete
  Else
    r = r + 1
  End If

Loop
End Su

b

 

[kevatarvind]

let Your Data be in A1:K10, then try to run a following code:

Sub Test()
Dim rng As Range
Set rng = Range("B2:K10")
For Each Cell In rng
If Cell <> "" Then
Cell.Cut
Cells(WorksheetFunction.Match(Cells(Cell.Row, 1), Range("A1:A10"), 0), Cell.Column).Select
ActiveSheet.Paste
End If
Next
Columns("A:A").Select
  ActiveSheet.Range("$A$2:$K$10").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A1").Select
End Sub

 

[bydganwil]

ADVERTISEMENT

Hi there,

The code you provided is not doing anything that I can see. When I run the code it gets to the 1st For statement and then the sub ends. In addition the xlfiltercopy to range M1 is not writing any data in the worksheet (assuming I understand what your code is trying to do?)

Thanks for your time really appreciated!!!!

 

[bydganwil]

Patel45 - That is looking like the ticket!!

Many thanks everyone

 

[kevatarvind]

let Your Data be in A1:K10, then try to run a following code:

Sub Test()
Dim rng As Range
Set rng = Range("B2:K10")
For Each Cell In rng
If Cell <> "" Then
Cell.Cut
Cells(WorksheetFunction.Match(Cells(Cell.Row, 1), Range("A1:A10"), 0), Cell.Column).Select
ActiveSheet.Paste
End If
Next
Columns("A:A").Select
  ActiveSheet.Range("$A$2:$K$10").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A1").Select
End Sub

 

[hurgadion]

Try to write in A1 the word "Target" and then try to run my Code... best regards.

Hi there,

The code you provided is not doing anything that I can see. When I run the code it gets to the 1st For statement and then the sub ends. In addition the xlfiltercopy to range M1 is not writing any data in the worksheet (assuming I understand what your code is trying to do?)

Thanks for your time really appreciated!!!!