![]() |
nested lookups ??
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 |
nested lookups ??
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 "shirley" wrote in message ... 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 |
nested lookups ??
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 InsertModule 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" wrote in message ... 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 "shirley" wrote in message ... 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 |
nested lookups ??
Ah yes, column B comes into play, didn't spot that.
-- __________________________________ HTH Bob "Roger Govier" <roger@technology4unospamdotcodotuk wrote in message ... 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 InsertModule 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" wrote in message ... 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 "shirley" wrote in message ... 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 |
All times are GMT +1. The time now is 04:46 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com