Help with VBA Looping

**DC88310** · 01-08-2013, 08:13 PM

Hey All,

I have to admit... its been a long time since i used excel VBA and I need some assistance if someone would be so kind to help me this evening!

I got a text file from a database and the info for each record is on 6 rows. Since the data is consistent all the way down, I created a macro with macro builder to save time to move the data exactly where i needed it for the first record... so that all the data i needed was on 1 line instead of 6, then in my macro i deleted the other 5 rows.

Now I am trying to remember how to loop this... and I cannot remember for the life of me the code i need to add to create the loop before and after the macro code. In short, I am shifting data around and because there will always be a indefinite number of entries, I need my macro to loop until there is no more data.

I won't bore you with the auto generated macro code because its sloppy and messy and I was trying to save some time by using the macro builder... LOL..

The first piece of data starts on Row2, column 3. Can anyone help me with a couple of lines of code?

Any help would be highly appreciated.

DC

**xladept** · 01-08-2013, 08:21 PM

Bore me with the code!

**Norie** · 01-08-2013, 08:21 PM

Bore us with the code - it'll show us what you are actually doing to move the 6 rows to 1 row.

**DC88310** · 01-08-2013, 08:54 PM

Ok Ok... i will bore you with the code... but remember... I did not hand write this.. LOL

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A3").Select
    Selection.Copy
    Range("A2").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    ActiveSheet.Paste
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D2").Select
    ActiveSheet.Paste
    Range("E4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E2").Select
    ActiveSheet.Paste
    Range("F6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste
    Range("H7:GC7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-9
    Range("H2").Select
    ActiveSheet.Paste
    Rows("3:7").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

**xladept** · 01-08-2013, 09:42 PM

Here's how I would interpret your code:

Sub DC88310(): Dim i As Long, r As Long
        r = Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To r
            Range("A" & i + 1).Copy Range("A" & i)
            Range("B" & i + 3).Copy Range("B" & i)
            Range("D" & i + 3).Copy Range("D" & i)
            Range("E" & i + 2).Copy Range("E" & i)
            Range("F" & i + 4).Copy Range("F" & i)
            Range("H" & i + 5 & ":GC" & i + 5).Copy Range("H" & i)
            Rows(CStr(i + 1) & ":" & CStr(i + 5)).Delete Shift:=xlUp
            r = r - 5: Next i
        End Sub

**DC88310** · 01-08-2013, 09:59 PM

You da bomb! That worked perfectly. I have never seen it done that way either...

I am very grateful for your help!

DC

**Norie** · 01-08-2013, 10:35 PM

Try this, it worked on a mocked up version of how I think the data is laid out.

Dim rng As Range

    Set rng = Range("A3")

    While rng.Value <> ""

        rng.Copy rng.Offset(-1)
        rng.Offset(2, 1).Copy rng.Offset(-1, 1)
        rng.Offset(2, 3).Copy rng.Offset(-1, 3)
        rng.Offset(1, 4).Copy rng.Offset(-1, 4)
        rng.Offset(3, 5).Copy rng.Offset(-1, 5)
        rng.Offset(4, 7).Resize(, 178).Copy rng.Offset(-1, 7)
        rng.Resize(5).EntireRow.ClearContents

        Set rng = rng.Offset(5)
    Wend

    Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

**xladept** · 01-08-2013, 10:41 PM

Yeah, I saw that CStr trick on a recent post on this forum and - You're welcome!

Help with VBA Looping

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Re: Help with VBA Looping

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions