Loop until condition is met

**Toimia** · 03-08-2011, 09:55 AM

Hi,

I recently have been trying to write a macro which will copy the ranges A1:37, paste it a few rows below and then copy B1:37, paste it in the column alongside the copied A values and keep looping this process(keeping the A1:37 but changing B to C, D, ect until it reaches QI).

As it's quite hard to explain, here's the recorded macro of the intial process. I would like to know the commands which will change B into a variable so I can keep moving one column along; pasting it below the previous pasted content- and the correct IF syntax to end the macro once it reaches QI.

Many thanks

Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+h
'
    Range("A1:A37").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=21
    Range("A41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-33
    Range("B1:B37").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=15
    Range("B41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=24
    Range("A41:B77").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A41:A77").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("C41").Select
    ActiveWindow.SmallScroll Down:=3
End Sub

And here's mine

Sub Macro55()

Dim cln
Dim cla
cln = ColumnNumber
cla = ColumnNumber - 1
cln = 2

    Do Until cln > 451

    Range("A1:A37").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=21
    ActiveSheet.Range("cln41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-33
    Range("cla1:cln37").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=15
    Range("cla41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=24
    Range("cla41:cln77").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0

    End With
    cln = cln + 2
        Loop
End Sub

**6StringJazzer** · 03-08-2011, 04:28 PM

Originally Posted by Toimia

I recently have been trying to write a macro which will copy the ranges A1:37, paste it a few rows below and then copy B1:37, paste it in the column alongside the copied A values and keep looping this process(keeping the A1:37 but changing B to C, D, ect until it reaches QI).

I can do this, but first can you explain why you want to do it one column at a time? Why not just copy the whole range A1:QI37 to the desired destination in a single command?

**Toimia** · 03-08-2011, 05:38 PM

Originally Posted by 6StringJazzer

I can do this, but first can you explain why you want to do it one column at a time? Why not just copy the whole range A1:QI37 to the desired destination in a single command?

Long story short, it's part of a customer excel document which was imported from a SQL database dump. 'A' column contains the headers to the certain fields which need to be copied first before copying the data in the other columns(each column after 'A' has the customers details in). So the final chunks(A+B, A+C, A+D ect) can be copied across into a word document.

If you could do this asap I would greatly appriciate it. You would've saved me so many hours of work

- Toimia

**6StringJazzer** · 03-08-2011, 07:00 PM

I didn't follow your explanation or your code but I'm starting to get the idea that this is what you want to do.

Lesson 1 is that code generated by the macro recorder can be instructive but is usually pretty bloated and inefficient.

Not sure what you're trying to do with formatting but I tried to replicate what you had.

Try this:

Public Sub test()

   Dim sourceCol As Long
   Dim destCol As Long
   
   
   destCol = 1
   
   For sourceCol = 2 To 451
   
      
      Range("A1:A37").Copy Destination:=Cells(41, destCol)
      Range(Cells(1, sourceCol), Cells(37, sourceCol)).Copy Destination:=Cells(41, destCol + 1)
      
      With Range(Cells(41, destCol), Cells(77, destCol + 1))
      
         .Borders(xlDiagonalDown).LineStyle = xlNone
         .Borders(xlDiagonalUp).LineStyle = xlNone
         
         With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
         With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
         With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
         With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
         With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
         With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
         End With
      End With
      
      With Cells(41, destCol).Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = -0.149998474074526
         .PatternTintAndShade = 0
      End With
      
      destCol = destCol + 2
      
   Next sourceCol



End Sub