0

Above in the picture you see how the data is currently arranged, below you see how I want to rearrange the data. Unforutnatley the code I wrote doesn't work. Help in this regard would be greatly appreciated.

The code should start at Cell B2 and iterate through the column, rearranging the data horizontally according to the picture (see picture description).

The for-loop works for square 1 (street address 1, zip 1 and so on)is arranged horizontally, but not for the following squares.

Help in this regard would be greatly appreciated. Many thanks.

Do While IsEmpty(Cells(iRange, 2)) = False

    For i = iRange To iLimit
        
        Cells(i, iRange).Select
        j = i
        Selection.Cut Destination:=Cells(iRange, j)
            
    Next i
        
    iRange = iRange + 6
    iLimit = iLimit + 6

Loop
Nicolas Peyer
  • 33
  • 3
  • You `Do While` loop only works until you find the first empty cell. There is an empty cell between your 2 address. I suspect that's whats causing the issue. Although it's difficult to workout what you are doing without know what the initial value of `iRange` is – Zac Aug 20 '20 at 11:07
  • @Zac the original value of iRange is 2. I thought that it would skip over the empty cells. – Nicolas Peyer Aug 20 '20 at 11:17
  • @Porcupine911 yes, partially but how would I change this solution when the paste cells change (how to automate it)? – Nicolas Peyer Aug 20 '20 at 11:19

1 Answers1

1

You don't need to do a while loop here, a for loop with an upper range of usedrange.rows.count will set the variable to be the last row with data in it (even if there's white space between data)

The code below will take the vertical data and rearrange it to be horizontal (overwriting what is there already)

It assumes that the data will always been in the same format with 1 blank row separating entries (you can tweak the counter resets if you need)

Sub RunMe()
Dim lrow As Integer
lrow = ActiveSheet.UsedRange.Rows.Count 'Last row with data (even if there's blanks)
Dim IRange As Integer
Dim j As Integer
j = 1 'We'll use this as our column counter for pasting
IRange = 1 'We'll use this as our row counter for pasting
For i = 1 To lrow
        Cells(i, 1).Cut Cells(IRange, j) 'Cut and paste
        If j = 6 Then 'If we've used up 6 columns of pasting we want to jump to the next row for pasting
            j = 1 'also reset our column counter to 1
            IRange = IRange + 1
        Else
            j = j + 1 'increase our column counter
        End If
Next i
End Sub
Veegore
  • 111
  • 6