excel vba question

[k.vangeffen]

Hi all,

Can someone help me with this?
I know just about nothing about vba so..

I attached part of the file as example.
I need row 2 to 6 pasted after the 3 cells in row 1.
Rows 8 to 11 pasted after row 7 etc etc.
So I want the cells to be cut, past special at the end of row 1 and the
other cells behind row 7 etc etc..
As you can see, the rows that need to bee pasted are not al the same
amount of rows, otherwise I would be able to figure it out.
I think I have to do something with the # but what???

Please help me!!

Best regards,

Krien

[Sandy Mann]

Krien,

Attaching files to posts in these NG's is very much frowned on because it
increases the download time and some people on dial-up are paying for access
by the minute. It is almost never necessary to attach files - it never
ceases to amaze me how the people in these NG's can pick out from text
explanations of the problem what it is that the person is asking. If
someone wants to see your file they may ask you to send it privately so that
it does not clog up the network.

That said, how many rows of data do you have? This simple macro runs at
just over 1 second per 1,000 rows on my laptop:

Sub MoveIt()
Dim ThisRow As Long
Dim ThisRow As Long

Application.ScreenUpdating = False

endrow = Cells(Rows.Count, 1).End(xlUp).Row

For ThisRow = 2 To endrow
If Cells(ThisRow, 2).Value = "" Then
Cells(ThisRow, 1).Cut Destination:=Cells(ThisRow - 1, 4)
End If
Next ThisRow

Application.ScreenUpdating = True

End Sub

--
HTH

Sandy
[email protected]
[email protected] with @tiscali.co.uk


"k.vangeffen" <[email protected]> wrote in message
news:[email protected]...
> Hi all,
>
> Can someone help me with this?
> I know just about nothing about vba so..
>
> I attached part of the file as example.
> I need row 2 to 6 pasted after the 3 cells in row 1.
> Rows 8 to 11 pasted after row 7 etc etc.
> So I want the cells to be cut, past special at the end of row 1 and the
> other cells behind row 7 etc etc..
> As you can see, the rows that need to bee pasted are not al the same
> amount of rows, otherwise I would be able to figure it out.
> I think I have to do something with the # but what???
>
> Please help me!!
>
> Best regards,
>
> Krien
>

[k.vangeffen]

Hi Sandy,

Sorrie you are so right, it shows how spoiled I am for years now, I
don't even realise that there are still people left with dail in.

This being said, can I ask you one more question?
It works great except the transpose part.
You would say I would be able to figure this last bit out but..

Regards en manny thanks,

Krien

Sandy Mann wrote:
> Krien,
>
> Attaching files to posts in these NG's is very much frowned on because it
> increases the download time and some people on dial-up are paying for access
> by the minute. It is almost never necessary to attach files - it never
> ceases to amaze me how the people in these NG's can pick out from text
> explanations of the problem what it is that the person is asking. If
> someone wants to see your file they may ask you to send it privately so that
> it does not clog up the network.
>
> That said, how many rows of data do you have? This simple macro runs at
> just over 1 second per 1,000 rows on my laptop:
>
> Sub MoveIt()
> Dim ThisRow As Long
> Dim ThisRow As Long
>
> Application.ScreenUpdating = False
>
> endrow = Cells(Rows.Count, 1).End(xlUp).Row
>
> For ThisRow = 2 To endrow
> If Cells(ThisRow, 2).Value = "" Then
> Cells(ThisRow, 1).Cut Destination:=Cells(ThisRow - 1, 4)
> End If
> Next ThisRow
>
> Application.ScreenUpdating = True
>
> End Sub
>

[Sandy Mann]

Sorry Krien, I didn't read your post closely enough.

Try this, but remember to backup your data first:

Sub TransposeIt()
Dim ColA As Long
Dim ColB As Long

Application.ScreenUpdating = False

'Find bottom rows in Columns A & B
ColA = Cells(Rows.Count, 1).End(xlUp).Row
ColB = Cells(Rows.Count, 2).End(xlUp).Row

'Copy data, transpose & clear old data
Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range(Cells(ColB + 1, 1), Cells(ColA, 1)).ClearContents

'Loop up through remaining data
Do Until ColB = 1
ColA = ColB - 1
ColB = Cells(ColB, 2).End(xlUp).Row

Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range(Cells(ColB + 1, 1), Cells(ColA, 1)).ClearContents
Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

If you want to remove the blank lines between the data then try:

Sub TransposeIt2()
Dim ColA As Long
Dim ColB As Long

Application.ScreenUpdating = False

'Find bottom rows in Columns A & B
ColA = Cells(Rows.Count, 1).End(xlUp).Row
ColB = Cells(Rows.Count, 2).End(xlUp).Row

'Copy data, transpose & delete rows
Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Delete

'Loop up through remaining data
Do Until ColB = 1
ColA = ColB - 1
ColB = Cells(ColB, 2).End(xlUp).Row

Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range(Cells(ColB + 1, 1), Cells(ColA, 1)) _
.EntireRow.Delete shift:=xlUp
Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Just hope that I write better procedures then I read <g>
--
HTH

Sandy
[email protected]
[email protected] with @tiscali.co.uk

"k.vangeffen" <[email protected]> wrote in message
news:[email protected]...
> Hi Sandy,
>
> Sorrie you are so right, it shows how spoiled I am for years now, I don't
> even realise that there are still people left with dail in.
>
> This being said, can I ask you one more question?
> It works great except the transpose part.
> You would say I would be able to figure this last bit out but..
>
> Regards en manny thanks,
>
> Krien
>
> Sandy Mann wrote:
>> Krien,
>>
>> Attaching files to posts in these NG's is very much frowned on because it
>> increases the download time and some people on dial-up are paying for
>> access
>> by the minute. It is almost never necessary to attach files - it never
>> ceases to amaze me how the people in these NG's can pick out from text
>> explanations of the problem what it is that the person is asking. If
>> someone wants to see your file they may ask you to send it privately so
>> that
>> it does not clog up the network.
>>
>> That said, how many rows of data do you have? This simple macro runs at
>> just over 1 second per 1,000 rows on my laptop:
>>
>> Sub MoveIt()
>> Dim ThisRow As Long
>> Dim ThisRow As Long
>>
>> Application.ScreenUpdating = False
>>
>> endrow = Cells(Rows.Count, 1).End(xlUp).Row
>>
>> For ThisRow = 2 To endrow
>> If Cells(ThisRow, 2).Value = "" Then
>> Cells(ThisRow, 1).Cut Destination:=Cells(ThisRow - 1, 4)
>> End If
>> Next ThisRow
>>
>> Application.ScreenUpdating = True
>>
>> End Sub
>>

[k.vangeffen]

Hi Sandy,

Thanks, you're great!!!
It works, you're a lifesaver!

Krien

Sandy Mann wrote:
> Sorry Krien, I didn't read your post closely enough.
>
> Try this, but remember to backup your data first:
>
> Sub TransposeIt()
> Dim ColA As Long
> Dim ColB As Long
>
> Application.ScreenUpdating = False
>
> 'Find bottom rows in Columns A & B
> ColA = Cells(Rows.Count, 1).End(xlUp).Row
> ColB = Cells(Rows.Count, 2).End(xlUp).Row
>
> 'Copy data, transpose & clear old data
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
> Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=True
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).ClearContents
>
> 'Loop up through remaining data
> Do Until ColB = 1
> ColA = ColB - 1
> ColB = Cells(ColB, 2).End(xlUp).Row
>
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
> Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=True
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).ClearContents
> Loop
>
> Application.CutCopyMode = False
> Application.ScreenUpdating = True
>
> End Sub
>
> If you want to remove the blank lines between the data then try:
>
> Sub TransposeIt2()
> Dim ColA As Long
> Dim ColB As Long
>
> Application.ScreenUpdating = False
>
> 'Find bottom rows in Columns A & B
> ColA = Cells(Rows.Count, 1).End(xlUp).Row
> ColB = Cells(Rows.Count, 2).End(xlUp).Row
>
> 'Copy data, transpose & delete rows
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
> Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=True
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Delete
>
> 'Loop up through remaining data
> Do Until ColB = 1
> ColA = ColB - 1
> ColB = Cells(ColB, 2).End(xlUp).Row
>
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)).Copy
> Cells(ColB, 4).PasteSpecial Paste:=xlAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=True
> Range(Cells(ColB + 1, 1), Cells(ColA, 1)) _
> .EntireRow.Delete shift:=xlUp
> Loop
>
> Application.CutCopyMode = False
> Application.ScreenUpdating = True
>
> End Sub
>
> Just hope that I write better procedures then I read <g>

[Sandy Mann]

You're welcome. After chastising you for attaching a spreadsheet I lazily
didn't bother to clip off the old text from my reply. Harlan will not be
pleased with me. <g>

--
HTH

Sandy
[email protected]
[email protected] with @tiscali.co.uk