Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Trying to Split and delete
Hi Experts,
Here is what I'm trying to do and my code. 1. I have a table (which is dynamic and will change from Project to Project so I can NOT HARD CODE THE MACRO) Col A Col B Col C Month Planned Actual Row# 1 Jan 50 48 Row# 2 Feb 55 54 Row# 3 Mar 58 60 Row# 4 Apr 60 62 Row# 5 May 65 65 Row# 6 Jun 68 65 Row# 7 Jul 75 70 Row# 8 Aug 85 84 Row# 9 Sep 100 95 Row# 10 2. User runs the macro and the required out put is Col A Col D Col E Col F Col G Date Planned 1 Actual 1 Planned 2 Actual 2 Jan 50 48 55 54 58 60 Apr 60 62 60 62 65 65 68 65 75 70 85 84 Sep 100 95 User will select a ROW by Clicking on the row# on the worksheet ONE TIME. So that the corresponding values in the column against that ROW sould be used for these alignments. 3. My code below does 50% of the requirement. 4. Request you to help. Thanks in advance... ---------------------------------------- My code Sub Test() ' ' ' Let user select a row of values by clicking on the row number listed on the work sheet Dim Rng As Range On Error Resume Next Set Rng = Application.InputBox(prompt:="PLEASE CLICK ON THE ROW NUMBERS LISTED on THE LEFT HAND SIDE TO SELECT A ROW", Type:=8) If Rng Is Nothing Then MsgBox "Operation Cancelled" Else Rng.Select With Selection.Interior .ColorIndex = 7 .Pattern = xlSolid End With '''''''''''''''''''''''''''' 'Populating project date fields from column A Dim kLastRow As Long Dim k As Long kLastRow = Cells(Rows.Count, "A").End(xlUp).Row If Not Rng Is Nothing Then Range("A2").Copy Range("E2") Rng.Copy Cells(Rng.Row, "E") 'Cells(kLastRow, "A").Copy Cells(kLastRow, "E") End If '''''''''''''''''''''''''''''''''' 'Populating column F and Col G Dim jLastRow As Long Dim j As Long jLastRow = Cells(Rows.Count, "B").End(xlUp).Row Range("B1").Resize(Rng.Row).Copy Range("F1") Rng.Offset(1, 0).Resize(iLastRow - Rng.Row).Copy Range("G2") 'Populating column H and Col I Dim lLastRow As Long Dim l As Long lLastRow = Cells(Rows.Count, "C").End(xlUp).Row Range("C1").Resize(Rng.Row).Copy Range("H1") Rng.Offset(1, 0).Resize(iLastRow - Rng.Row).Copy Range("I2") End If End Sub ------------------------------------------------------------------------ |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Trying to Split and delete
Prakash,
Your macro doesn't put the data in quite the same columns as your required output was suggesting. Have a go with this and see what you think. Sub Test() Dim Rng As Range, iSelectedRow As Integer, iLastRow As Integer, readrow As Integer 'Use your method to get the row, and colour it purple On Error Resume Next Set Rng = Application.InputBox(prompt:="PLEASE CLICK ON THE ROW NUMBERS LISTED on THE LEFT HAND SIDE TO SELECT A ROW", Type:=8) If Rng Is Nothing Then MsgBox "Operation Cancelled": Exit Sub Else: Rng.Interior.ColorIndex = 7 On Error GoTo 0 iSelectedRow = Rng.Row 'Find the last row in column A iLastRow = Cells(Rows.Count, "A").End(xlUp).Row If iSelectedRow iLastRow Then MsgBox ("The row must be in the table"): Exit Sub 'Write the headers for your table Range("e1").Value = "Date": Range("e1").Interior.ColorIndex = Range("a1").Interior.ColorIndex Range("f1").Value = "Planned1": Range("f1").Interior.ColorIndex = Range("b1").Interior.ColorIndex Range("g1").Value = "Actual1": Range("g1").Interior.ColorIndex = Range("c1").Interior.ColorIndex Range("h1").Value = "Planned2": Range("h1").Interior.ColorIndex = Range("b1").Interior.ColorIndex Range("i1").Value = "Actual2": Range("i1").Interior.ColorIndex = Range("c1").Interior.ColorIndex 'Write your table For readrow = 2 To iLastRow If readrow = 2 Or readrow = iSelectedRow Or readrow = iLastRow Then Cells(readrow, 5) = Cells(readrow, 1) If readrow <= iSelectedRow Then Cells(readrow, 6) = Cells(readrow, 2) Cells(readrow, 7) = Cells(readrow, 3) End If If readrow = iSelectedRow Then Cells(readrow, 8) = Cells(readrow, 2) Cells(readrow, 9) = Cells(readrow, 3) End If Next readrow End Sub -- Allllen "Prakash" wrote: Hi Experts, Here is what I'm trying to do and my code. 1. I have a table (which is dynamic and will change from Project to Project so I can NOT HARD CODE THE MACRO) Col A Col B Col C Month Planned Actual Row# 1 Jan 50 48 Row# 2 Feb 55 54 Row# 3 Mar 58 60 Row# 4 Apr 60 62 Row# 5 May 65 65 Row# 6 Jun 68 65 Row# 7 Jul 75 70 Row# 8 Aug 85 84 Row# 9 Sep 100 95 Row# 10 2. User runs the macro and the required out put is Col A Col D Col E Col F Col G Date Planned 1 Actual 1 Planned 2 Actual 2 Jan 50 48 55 54 58 60 Apr 60 62 60 62 65 65 68 65 75 70 85 84 Sep 100 95 User will select a ROW by Clicking on the row# on the worksheet ONE TIME. So that the corresponding values in the column against that ROW sould be used for these alignments. 3. My code below does 50% of the requirement. 4. Request you to help. Thanks in advance... ---------------------------------------- My code Sub Test() ' ' ' Let user select a row of values by clicking on the row number listed on the work sheet Dim Rng As Range On Error Resume Next Set Rng = Application.InputBox(prompt:="PLEASE CLICK ON THE ROW NUMBERS LISTED on THE LEFT HAND SIDE TO SELECT A ROW", Type:=8) If Rng Is Nothing Then MsgBox "Operation Cancelled" Else Rng.Select With Selection.Interior .ColorIndex = 7 .Pattern = xlSolid End With '''''''''''''''''''''''''''' 'Populating project date fields from column A Dim kLastRow As Long Dim k As Long kLastRow = Cells(Rows.Count, "A").End(xlUp).Row If Not Rng Is Nothing Then Range("A2").Copy Range("E2") Rng.Copy Cells(Rng.Row, "E") 'Cells(kLastRow, "A").Copy Cells(kLastRow, "E") End If '''''''''''''''''''''''''''''''''' 'Populating column F and Col G Dim jLastRow As Long Dim j As Long jLastRow = Cells(Rows.Count, "B").End(xlUp).Row Range("B1").Resize(Rng.Row).Copy Range("F1") Rng.Offset(1, 0).Resize(iLastRow - Rng.Row).Copy Range("G2") 'Populating column H and Col I Dim lLastRow As Long Dim l As Long lLastRow = Cells(Rows.Count, "C").End(xlUp).Row Range("C1").Resize(Rng.Row).Copy Range("H1") Rng.Offset(1, 0).Resize(iLastRow - Rng.Row).Copy Range("I2") End If End Sub ------------------------------------------------------------------------ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Delete first two characters in a cell... | Excel Worksheet Functions | |||
delete sheets from a workbook without creating linked formulae | Excel Discussion (Misc queries) | |||
Split a Cell? | Excel Worksheet Functions | |||
Delete specific text in spreadsheet | Excel Worksheet Functions | |||
Split or delete part of a number | Excel Discussion (Misc queries) |