nested lookups ??

  • Thread starter Thread starter shirley
  • Start date Start date
S

shirley

I have the following table of data:

1 a 6.1
1 b 6.2
1 c 6.3
2 a 6.4
2 b 6.5
2 d 6.6
3 a 6.7
3 d 6.8
3 e 6.9


how can I sort this to become:

a b c d e
1 6.1 6.2 6.3 0 0
2 6.4 6.5 0 6.6 0
3 6.7 0 0 6.8 6.9

any help is greatly appreciated?

cheers
 
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

.Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D")
.Rows(i).Delete
End If
Next i

.Columns(2).Delete
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
 
Hi Bob

I don't think that quite achieves what the OP was looking for.
If I understand her requirement correctly, then maybe this will do it

Sub sortData()
Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
Dim wss As Worksheet, wsd As Worksheet

Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wss.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
j = wss.Cells(i, 1).Value
k = Asc(wss.Cells(i, 2).Value) - 95
wsd.Cells(j + 1, 1) = j
wsd.Cells(j + 1, k) = wss.Cells(i, 3).Value
Next i
lc = wsd.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
For i = 2 To lc
wsd.Cells(1, i) = Chr(i + 95)
Next i
Application.ScreenUpdating = False
End Sub

Shirley, in order to use the proposed solution
Copy the Code above
Alt+F11 to invoke the VB Editor
Insert>Module
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run
 
Ah yes, column B comes into play, didn't spot that.

--
__________________________________
HTH

Bob

Roger Govier said:
Hi Bob

I don't think that quite achieves what the OP was looking for.
If I understand her requirement correctly, then maybe this will do it

Sub sortData()
Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
Dim wss As Worksheet, wsd As Worksheet

Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wss.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
j = wss.Cells(i, 1).Value
k = Asc(wss.Cells(i, 2).Value) - 95
wsd.Cells(j + 1, 1) = j
wsd.Cells(j + 1, k) = wss.Cells(i, 3).Value
Next i
lc = wsd.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
For i = 2 To lc
wsd.Cells(1, i) = Chr(i + 95)
Next i
Application.ScreenUpdating = False
End Sub

Shirley, in order to use the proposed solution
Copy the Code above
Alt+F11 to invoke the VB Editor
Insert>Module
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run

--
Regards
Roger Govier

Bob Phillips said:
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

.Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D")
.Rows(i).Delete
End If
Next i

.Columns(2).Delete
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


--
__________________________________
HTH

Bob
Click to expand...
Click to expand...
 
Back
Top