 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Excel / Worksheet Functions / August 2008How do I Lookup next values in Excel?
I've got a worksheet containing data similar to the following: Name1 Name2 Mark Sharon John Tracy Mark Tracy Mark Chloe Paul Emma Paul Stuart What I am trying to do is, on a new worksheet, obtain each unique name from Name1 and place it in column C. Beneath each unique name, I want to list the value(s) from Name2 in the cells in column B. The result should look something like: Mark sharon Tracy Chloe John Tracy Paul Emma Stuart Is it possible to do this in excel? I think you need to add a Macro. Best Regards, Jay > I've got a worksheet containing data similar to the following: > [quoted text clipped - 25 lines] > > Is it possible to do this in excel? Thanks Jay, but any clues as to how I do this? > I think you need to add a Macro. > [quoted text clipped - 30 lines] > > > > Is it possible to do this in excel? Hi, It's not so simple macro. But I will do it for you tomorrow. Best Regards, Jay > Thanks Jay, but any clues as to how I do this? > [quoted text clipped - 33 lines] >> > >> > Is it possible to do this in excel? Try this Alt + f11 to open VB editor. Right click 'This Workbook' and insert module and paste this on on the right and run it Copies the date from sheet 1 to sheet 2 so change that to suit Sub sonic() Sheets("Sheet1").Activate lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1") Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1") Sheets("Sheet2").Activate Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending For x = 1 To lastrow For y = x + 1 To lastrow If Cells(x, 2) = Cells(y, 2) Then Cells(y, 2).ClearContents End If Next Next End Sub Mike > Thanks Jay, but any clues as to how I do this? > [quoted text clipped - 32 lines] > > > > > > Is it possible to do this in excel? Thanks for the code Mike. Unfortunately this doesn't quite meet my needs. I've tested this out with the following data: A B 1 Mark Test 2 Mark Test 2 3 John Test The result from your code provides the following: A B 1 Test John 2 Test Mark 3 Test2 The result I'd like to get are: A B 1 John 2 Test 3 Mark 4 Test 5 Test2 Any ideas how to change you code to achieve this? > Try this > [quoted text clipped - 57 lines] > > > > > > > > Is it possible to do this in excel? Hi, Test it agin with this Sub sonic() Sheets("Sheet1").Activate lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1") Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1") Sheets("Sheet2").Activate Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending For x = 1 To lastrow For y = x + 1 To lastrow If Cells(x, 2) = Cells(y, 2) Then Cells(y, 2).ClearContents End If Next Next lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row Set myrange = Range("B2:B" & lastrow) For Each c In myrange If c.Offset(-1, 0) <> "" Then c.Insert Shift:=xlDown End If Next Range("A1").Insert Shift:=xlDown lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Set myrange = Range("A2:A" & lastrow) For Each c In myrange If c.Offset(, 1) <> "" Then c.Insert Shift:=xlDown End If Next End Sub Mike > Thanks for the code Mike. Unfortunately this doesn't quite meet my needs. > [quoted text clipped - 84 lines] > > > > > > > > > > Is it possible to do this in excel? Hi Mike, That's worked. Many thanks for doing this. Is it possible to extend the coding to incorporate 2 more fields? A B C D 1 Mark Test 18-08-08 0.5 2 Mark Test 2 28-08-08 3 3 John Test 18-08-08 0.5 The result I'd like to get are: A B C D E 1 John 2 Test 18-08-08 0.5 3 Mark 4 Test 18-08-08 0.5 5 Test2 25-08-08 3 > Hi, > [quoted text clipped - 121 lines] > > > > > > > > > > > > Is it possible to do this in excel? Hi, I'm beginning to acquire a feeling of ownership of this workbook :) Try this Sub marine() Sheets("Sheet1").Activate lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1") Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1") Range("C1:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("C1") Range("D1:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("D1") Sheets("Sheet2").Activate Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending For x = 1 To lastrow For y = x + 1 To lastrow If Cells(x, 2) = Cells(y, 2) Then Cells(y, 2).ClearContents End If Next Next lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row Set myrange = Range("B2:B" & lastrow) For Each c In myrange If c.Offset(-1, 0) <> "" Then c.Insert Shift:=xlDown End If Next Range("A1").Insert Shift:=xlDown Range("C1").Insert Shift:=xlDown Range("D1").Insert Shift:=xlDown lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Set myrange = Range("A2:A" & lastrow) For Each c In myrange If c.Offset(, 1) <> "" Then c.Offset(, 2).Insert Shift:=xlDown c.Offset(, 3).Insert Shift:=xlDown c.Insert Shift:=xlDown End If Next End Sub Mike > Hi Mike, > [quoted text clipped - 141 lines] > > > > > > > > > > > > > > Is it possible to do this in excel? Oops forgot to change this line Columns("A:D").Sort Key1:=Range("B1"), Order1:=xlAscending Mike > Hi, > [quoted text clipped - 185 lines] > > > > > > > > > > > > > > > > Is it possible to do this in excel? Hi Mike, I really appreciate all the effort you are providing for this solution. The code works brilliantly and I'm now trying to fit it into my worksheet in the appropriate position. I've tried amending the code which I assume relates to the destination. However, I think I've made a mistake somewhere as the code is running and running!! Firstly, do you know how to stop the code from running once it has started? Secondly, do I need to change the code to cater for the following requirements: 1) The original data contains header information in row 1. This header information is not needed on the destination worksheet. However, does the code need changing as the actual data that is needed starts in row 2? 2) The data being added to the destination worksheet needs to start in row 13 but in columns E, F, G and H. How do I change the code to cater for this? > Oops forgot to change this line > [quoted text clipped - 191 lines] > > > > > > > > > > > > > > > > > > Is it possible to do this in excel? Hi, To break an endless loop hold down the CTRL key and tap break. Click END in the box that pops up Try this. To correct the sheet names to what you want use the 'Replace function in the VB editor. Edit|replace Just a general point it is considered good posting to ask the question you want the answer to in the first place. Sub sonic() Sheets("Sheet1").Activate lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("A2:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13") Range("B2:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("E13") Range("C2:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("G13") Range("D2:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("H13") Sheets("Sheet2").Activate Range("E15:H" & lastrow + 13).Sort Key1:=Range("F13"), Order1:=xlAscending, Header:=xlNo lastrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row For x = 13 To lastrow For y = x + 1 To lastrow If Cells(x, 6) = Cells(y, 6) Then Cells(y, 6).ClearContents End If Next Next Set myrange = Range("F14:f" & lastrow) For Each c In myrange If c.Offset(-1, 0) <> "" Then c.Insert Shift:=xlDown End If Next Range("E13").Insert Shift:=xlDown Range("G13").Insert Shift:=xlDown Range("H13").Insert Shift:=xlDown lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row Set myrange = Range("E14:E" & lastrow) For Each c In myrange If c.Offset(, 1) <> "" Then c.Offset(, 2).Insert Shift:=xlDown c.Offset(, 3).Insert Shift:=xlDown c.Insert Shift:=xlDown End If Next End Sub Mike > Hi Mike, > [quoted text clipped - 212 lines] > > > > > > > > > > > > > > > > > > > > Is it possible to do this in excel? bug removed Sub sonic() Sheets("Sheet1").Activate lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("A2:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13") Range("B2:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("E13") Range("C2:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("G13") Range("D2:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("H13") Sheets("Sheet2").Activate Stop Range("E13:H" & lastrow + 13).Sort Key1:=Range("F13"), Order1:=xlAscending, Header:=xlNo lastrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row For x = 13 To lastrow For y = x + 1 To lastrow If Cells(x, 6) = Cells(y, 6) Then Cells(y, 6).ClearContents End If Next Next Set myrange = Range("F14:f" & lastrow) For Each c In myrange If c.Offset(-1, 0) <> "" Then c.Insert Shift:=xlDown End If Next Range("E13").Insert Shift:=xlDown Range("G13").Insert Shift:=xlDown Range("H13").Insert Shift:=xlDown lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row Set myrange = Range("E14:E" & lastrow) For Each c In myrange If c.Offset(, 1) <> "" Then c.Offset(, 2).Insert Shift:=xlDown c.Offset(, 3).Insert Shift:=xlDown c.Insert Shift:=xlDown End If Next End Sub Mike > Hi, > [quoted text clipped - 264 lines] > > > > > > > > > > > > > > > > > > > > > > Is it possible to do this in excel? Hi Mike, Sorry about being more specific earlier. I thought it may have been easier to explain the requirement in the way I did hoping that I'd be able to tweak the solution accordingly. I've had to make some minor amendments to the code as the worksheet data has now altered! When I run the following code, I get a "Compile Error: syntax error" which highlights the row after the "Stop". Sub sonic() Sheets("Training List").Activate lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row Range("E2:E" & lastrow).Copy Destination:=Sheets("Sheet2").Range("C13") Range("F2:F" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B13") Range("G2:G" & lastrow).Copy Destination:=Sheets("Sheet2").Range("D13") Range("H2:H" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13") Sheets("Sheet2").Activate Stop Range("B13:F" & lastrow + 13).Sort Key1:=Range("C13"), Order1:=xlAscending, Header:=xlNo lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row For x = 13 To lastrow For y = x + 1 To lastrow If Cells(x, 6) = Cells(y, 6) Then Cells(y, 6).ClearContents End If Next Next Set myrange = Range("C14:c" & lastrow) For Each c In myrange If c.Offset(-1, 0) <> "" Then c.Insert Shift:=xlDown End If Next Range("B13").Insert Shift:=xlDown Range("D13").Insert Shift:=xlDown Range("F13").Insert Shift:=xlDown lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row Set myrange = Range("B14:B" & lastrow) For Each c In myrange If c.Offset(, 1) <> "" Then c.Offset(, 2).Insert Shift:=xlDown c.Offset(, 3).Insert Shift:=xlDown c.Insert Shift:=xlDown End If Next End Sub Do you know what could be wrong? > bug removed > [quoted text clipped - 270 lines] > > > > > > > > > > > > > > > > > > Mike Hi Mike, I've resolved my syntax issue and it is all working perfectly now apart from the final column (col F). It only displays the unique values and on the incorrect rows. For example, the data being read is: E F G H 2 Mark Test 18-08-08 0.5 3 Mark Test 2 28-08-08 3 4 John Test 18-08-08 0.5 5 Mike Test 3 19-08-08 1 The result I'm now getting is: B C D E F 13 John 14 Test 18-08-08 0.5 15 Mark 1 16 Test 18-08-08 3 17 Test2 25-08-08 18 Mike 19 Test3 19-08-08 The result I'd like to achieve is: B C D E F 13 John 14 Test 18-08-08 0.5 15 Mark 16 Test 18-08-08 0.5 17 Test2 25-08-08 3 18 Mike 19 Test3 19-08-08 1 > bug removed > [quoted text clipped - 270 lines] > > > > > > > > > > > > > > > > > > Mike try this one assumes first names are in A column, surnames are in B the result will be stored in C select all yr first names in A column and run the macro: Sub listeczka() Dim cell As Range Dim cel As Range Dim counter As Integer Dim ile As Integer Range("C:D").ClearContents counter = 0 ile = 0 For Each cell In Selection If Application.WorksheetFunction.CountIf(Range("C:C"), cell) = 0 Then ile = 0 For Each cel In Selection If cel = cell Then counter = counter + 1 If Application.WorksheetFunction.CountIf(Range("C:C"), cel) = 0 Then Cells(counter, 3) = cel ile = ile + 1 Cells(counter + ile, 3) = cel.Offset(0, 1) Else: Cells(counter + ile, 3) = cel.Offset(0, 1) End If Else: GoTo next_cel End If next_cel: Next cel Else: GoTo next_cell End If counter = counter - Application.WorksheetFunction.CountIf(Range("C:C"), cell) + 2 next_cell: Next cell End Sub HIH yet another one will bold and underline first names HIH Sub listeczka() Dim cell As Range Dim cel As Range Dim counter As Integer Dim ile As Integer Range("C:C").Clear counter = 0 ile = 0 For Each cell In Selection If Application.WorksheetFunction.CountIf(Range("C:C"), cell) = 0 Then ile = 0 For Each cel In Selection If cel = cell Then counter = counter + 1 If Application.WorksheetFunction.CountIf(Range("C:C"), cel) = 0 Then With Cells(counter, 3) .Value = cel .Font.Bold = True .Font.Underline = True End With ile = ile + 1 Cells(counter + ile, 3) = cel.Offset(0, 1) Else: Cells(counter + ile, 3) = cel.Offset(0, 1) End If Else: GoTo next_cel End If next_cel: Next cel Else: GoTo next_cell End If counter = counter - Application.WorksheetFunction.CountIf(Range("C:C"), cell) + 2 next_cell: Next cell End Sub |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.