Copying cells based on alternate cell value

[mayf]

Hello,

I am wondering if it possible to automate the copying of data from particular cells, based on a value in a different cell, into a different format.

So to go from this simplified table:

<table style="font-family:Arial,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"></colgroup><tbody><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>A</td><td>B</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">1</td><td style="font-weight:bold; ">Name</td><td style="font-weight:bold; ">Level</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">2</td><td>Arthur</td><td style="text-align:right; ">2a</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">3</td><td>Briony</td><td>3c</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">4</td><td>Catherine</td><td>3b</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">5</td><td>David</td><td style="text-align:right; ">3a</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">6</td><td>Edward</td><td style="text-align:right; ">2a</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">7</td><td>Felicity</td><td>3c</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">8</td><td>George</td><td>3c</td></tr></tbody></table>
to something like this:

<table style="font-family:Arial,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"></colgroup><tbody><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>F</td><td>G</td><td>H</td><td>I</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">1</td><td style="font-weight:bold; text-align:right; ">2a</td><td style="font-weight:bold; ">3c</td><td style="font-weight:bold; ">3b</td><td style="font-weight:bold; text-align:right; ">3a</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">2</td><td>Arthur</td><td>Briony</td><td>Catherine</td><td>David</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">3</td><td>Edward</td><td>Felicity</td><td>
</td><td>
</td></tr><tr style="height:17px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">4</td><td>
</td><td>George</td><td>
</td><td>
</td></tr></tbody></table>
At the moment I do it all manually, and it takes forever. I am sure there must be a simple way of doing it. I am using Excel 2003, but could work in a newer version if required.

Many thanks.

Excel tables to the web >> Excel Jeanie HTML 4

 

[SteveO59L]

Something along the lines of

Dim c1 As Range, rng1
Dim c2 As Range, rng2
Dim c1_col As Integer

Dim LASTROW As Long

Set rng1 = Range("f1:i1")
Set rng2 = Range("b2:b8")

For Each c1 In rng1

For Each c2 In rng2

If c2.Value = c1.Value Then
c1_col = c1.Column

LASTROW = Cells(Rows.Count, c1_col).End(xlUp).Row

Cells(LASTROW + 1, c1_col).Value = c2.Offset(0, -1).Value
End If
Next c2
Next c1

 

[bappakarmakar]

u try this,

Sub dist()
Dim rng As Range, cnt As Integer, name As Range, k As Integer, i As Integer, j As Integer, p As Integer

Sheets("Sheet2").Select
Range("C1:C8").Value = Range("B1:B8").Value
Sheets("Sheet2").Range("$C$1:$C$8").RemoveDuplicates Columns:=1, Header:=xlNo
Set rng = Sheets("Sheet2").Range("C1:C8")
cnt = Application.WorksheetFunction.CountA(rng)
Set name = Range("A1:A8")
k = 4
For i = 1 To cnt
p = 1

For j = 1 To 8
If Range("C" & i).Value = Range("B" & j).Value Then
ActiveSheet.Columns(k).Cells(p) = name.Cells(j)
p = p + 1
End If
Next j
k = k + 1
Next i

End Sub

 

[mayf]

Thanks for the quick responses. I will try both.

 

[mayf]

Steve, I don't know if I'm doing anything wrong, but nothing appears to happen when I run your code.

Bappa, I get a run-time 438 error with this line:
Sheets("Sheet2").Range("$C$1:$C$8").RemoveDuplicates Columns:=1, Header:=xlNo

Thanks again for both your efforts.

 

[SteveO59L]

Is your data laid out exactly as in your example ?

 

[mayf]

It is.

 

[SteveO59L]

Send me a p.m with your e-mail address and I'll send you my working file

 

[mayf]

Done.

 

[SteveO59L]

Incoming