PDA

View Full Version : arranging data redux



kurt0101
06-30-2008, 07:26 PM
Hi. I have a macro that arranges data in a particular way. I always have my data on cell A18-A*** to H18-H*** when I run the macro.
My only problem is that after I run the macro it "picks up" the data and shifts it all the way to cell J18 (9 columns) but I want the output to START at A18-H18, then J18-Q18 etc etc. I do not understand why it is shifting it over. that is the only thing i want to change.
I have pasted it below. thank you very much



Sub DoIt()
Selection.CurrentRegion.Select
On Error GoTo cancelled
Set UserRange = _
Application.InputBox("Confirm or adjust the range to process (include the headers)", _
"Confirm range to process", Selection.Address, , , , , 8)
UserRange.Select
On Error GoTo 0
'Selection.Sort Key1:=Selection.Range("B4"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
'pd changed line below
Selection.Sort Key1:=Range("C15"), Order1:=xlAscending, Key2:=Range("B15"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal

Set myheaders = Selection.Rows(1)

Selection.Rows("2:" & Selection.Rows.Count).Select
SelTopRow = Selection.Row
SelWidth = Selection.Columns.Count
batchno = 1 'pd changed
Rw = 1
startrow = 1
Do Until Rw > Selection.Rows.Count
Do Until Selection.Cells(startrow, 2) <> Selection.Cells(Rw + 1, 2) Or _
Selection.Cells(startrow, 3) <> Selection.Cells(Rw + 1, 3) Or Rw > _
Selection.Rows.Count 'pd changed
Rw = Rw + 1
Loop
If Selection.Rows(startrow).Cells(2) <> "" Then 'batchno > 0 Then 'pd changed
Set mysource = Selection.Rows(startrow & ":" & Rw)
Set mydest = Selection.Cells(1, 1).Offset(, batchno * (SelWidth + _
1)).Resize(Rw - startrow + 1, SelWidth)
mysource.Copy mydest
mysource.Clear
Set mydest = mydest.Rows(1).Offset(-1)
myheaders.Copy mydest
thisDepth = mydest.Cells(1).End(xlDown).Row - mydest.Row
lastDepth = mydest.Cells(1).Offset(, -2).End(xlDown).Row - _
mydest.Row
blackDepth = WorksheetFunction.Max(thisDepth, lastDepth)
mydest.Cells(1).Offset(, -1).Resize(blackDepth + _
1).Interior.ColorIndex = 1
mydest.Cells(1).Offset(, -1).ColumnWidth = 12#
mydest.EntireColumn.AutoFit
End If
Rw = Rw + 1: startrow = Rw: batchno = batchno + 1
Loop
Selection.Offset(-1).Resize(Selection.Rows.Count + 1, _
Selection.Columns.Count + 1).Delete Shift:=xlToLeft 'pd added

cancelled:
End Sub

Reformatted code to stop side scrolling.
~Oorang

Oorang
07-09-2008, 08:02 AM
Can you post a sample workbook (without the code, just data that this code might be run on)?

kurt0101
07-26-2008, 08:09 PM
Hello. Thank you the inquiry. I have attached a sample excel file that shows hopefully exactly what i mean.
please let me know if you have any questions.
thank you

Bob Phillips
07-27-2008, 04:46 AM
I am not clear as to what you want to do. Will Input be copied to the same sheet or another one? Will this be run many times, with new data? If so, where will the new data be? and so on.

kurt0101
07-27-2008, 06:34 AM
Hi XLd. Thank you for the question.
the input should be on the same sheet as the output.
i would like to paste some data into sheet 1. run the macro on sheet 1 and have the data arranged as in the "desired output" on sheet 1.
i just broke it up into 3 worksheets in "sample.xls" to be clear as to what i wanted.

yes this will be run many many many times but on different excel files. so i just need it done once for now.

thank you much sir