How do I split column?

[Guest]

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
------------------------------------------------------------------------

 

[Guest]

Hi Prakash,

I don't understand why you posted this below.
What is wrong with the solution I gave you:

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

 

[Guest]

Thanks Allen for the solution.

I'll definately try it out, however, I want the solution to be more
generic(without hardcoding)..let us try that..

Thanks..reposting was not to hurt you..I'm sorry if it has hurt you..

Regards

 

[Guest]

No, no problem, but you have to be more specific when you talk about
hardcoding.

For example, in your own code you are quite happy to copy the column headers
across. Is that OK or not?

Also I have "hardcoded" row 2 as the first row of data. Is that acceptable
or not? If not, will your data be structured in such a way that we can know
somehow what the first row is? Go into your data table and press ctrl-*
(control and asterisk). Does that completely select the data table you are
working with? If you can promise that your data table is built like this,
with one row of headers and all the rest is data, then I will be able to help
you.

In your code you started to detect the last row of column A and also of
column C. Why did you do that?

I have also "hardcoded" the columns that the data is written into. Is that
allowed to be controlled in the code? If not, how are you going to know
where to write the data?

So in summary, explain a little bit more and I will give you a more powerful
code.