Question

Each row on my sheet represents a currency trade. The first 3 cells in each row state the currency, date and price. Each 3 cells after that state what each account is doing. Trades can have any number of accounts so the rows vary in length. For each trade (row) I want each account to have its own unique row which shows the currency, date, price, buy/sell, quantity, account.

**Example**


1          2       3    4   5    6    7    8    9  10  11   12  13
-------------------------------------------------------------------------------

EURUSD  1/1/13   1.30  Buy 100  acc1 Buy 1000 Acc2 Buy 100 acc3 Buy .....
EURUSD  2/1/13   1.31  Buy 1000 acc1 Buy 1000 Acc2 Buy 100 acc3 Buy .....
 .
 .
 .




**WOULD BECOME**

EURUSD  1/1/13   1.30 Buy 100  acc1
EURUSD  1/1/13   1.30 Buy 1000 Acc2
EURUSD  1/1/13   1.30 Buy 100  Acc3
.         .        .
.         .        .
.         .        .
EURUSD  2/1/13   1.31 Buy 1000 acc1
EURUSD  2/1/13   1.31 Buy 1000 acc2
EURUSD  2/1/13   1.31 Buy 100  acc3

I have written some code (below) that I hope to achieve this with but I think I have an infinite loop in there. For each row I start in column 4, if its a buy or sell

I’ve tried a number of changes but same problem. I’m sure its staring me in the face but i cant see my error. Can anyone suggest corrections please? By the way its not the prettiest code so if you have a better solution I’m all ears. Thanks

Sub changeformat()


Dim p As Integer
Dim r As Integer
Dim c As Integer




p = 150
For r = 1 To 140
c = 4
Range("A" & r).Select

    Do While ActiveCell.Value = """"
         Do Until c = 303
                Cells(r, c).Select
                If InStr(ActiveCell.Value, "Buy") > 0 Or InStr(ActiveCell.Value,"Buy")  > 0 Then

                'The first 3 cells will of each new row will be the same as the first 3 cells
                'of current active 'original' row

                ActiveSheet.Cells(p, 1).Value = ActiveSheet.Cells(r, 1).Value
                ActiveSheet.Cells(p, 2).Value = ActiveSheet.Cells(r, 2).Value
                ActiveSheet.Cells(p, 3).Value = ActiveSheet.Cells(r, 3).Value

                'The active cell and the 2 cells that follow will be pasted to
                'columns D to F in row p

                ActiveSheet.Cells(p, 4).Value = ActiveSheet.Cells(r, c).Value
                ActiveSheet.Cells(p, 5).Value = ActiveSheet.Cells(r, c + 1).Value
                ActiveSheet.Cells(p, 6).Value = ActiveSheet.Cells(r, c + 2).Value


                p = p + 1
                c = c + 3
                End If

        Loop
    Loop
Next r





End Sub

Edit

I made the following changes, the infinite loop seems to have stopped. it now does almost what it is suppose to but it is ommitting data. For example, the first row on my sheet only has 9 cells (2 accounts). The 2nd has 33 (10 accounts). These 2 rows should translate to 12 new rows for 12 accounts. Unfortunately, it only is copying down the first account in each row. it does this for the first 11 rows, then it works for rows 12 and 13. Any suggestions on what might be happening? Thanks

p = 150
For r = 1 To 140

If Range("A" & r).Value <> "" Then

    'Do While Range("A" & r) <> """"
         For c = 4 To 303
                Cells(r, c).Select
                If ActiveCell.Value <> "" Then
                If InStr(ActiveCell.Value, "Buy") > 0 Or InStr(ActiveCell.Value, "Buy") > 0 Then

                'The first 3 cells will of each new row will be the same as the first 3 cells
                'of current active 'original' row

                ActiveSheet.Cells(p, 1).Value = ActiveSheet.Cells(r, 1).Value
                ActiveSheet.Cells(p, 2).Value = ActiveSheet.Cells(r, 2).Value
                ActiveSheet.Cells(p, 3).Value = ActiveSheet.Cells(r, 3).Value

                'The active cell and the 2 cells that follow will be pasted to
                'columns D to F in row p

                ActiveSheet.Cells(p, 4).Value = ActiveSheet.Cells(r, c).Value
                ActiveSheet.Cells(p, 5).Value = ActiveSheet.Cells(r, c + 1).Value
                ActiveSheet.Cells(p, 6).Value = ActiveSheet.Cells(r, c + 2).Value


                p = p + 1

                End If
                End If

        Next c
    'Loop
    End If
Next r

Answer 1

Try changing your loop condition from this

Do While ActiveCell.Value = """"

to this

Do While ActiveCell.Value = "'' ''"

….alternatively to prove to yourself what is happening open a blank workbook and open the immediate window (Ctl+G) and run this ActiveCell.Value = """" and look at what it puts in the cell-probably not what you want.

In VBA two of these ' in a string actually equals one of these "

So maybe the condition of your Do-Loop is never met.

---

EDIT

…in your examples of the data I can’t see this "" ?

---

EDIT2

I’ve noticed an IF that doesn’t look like it is required. Do you know how to step through a macro? This is far and away the best way to find problems with a complicated loop like this.

1. Put the cursor at the top of the macro just under the line Sub ...
2. Press F8
3. The first line should now be highlighted
   Every time you now press F8 one line of code will be executed and you will be able to see what happens in on the worksheet plus if you hover the cursor over any of the variables in the IDE it will tell you what it’s current value is.
4. Do a couple of loops and the problem will probably be obvious to you with the actual sheet in front of you.
5. If you want to just let it run to the end press F5 otherwise you can stop it midway.

Dim p As Integer
Dim r As Integer
Dim c As Integer

p = 150
For r = 1 To 140

with Excel.Activesheet
If .Range("A" & r) <> "" Then '<<<<<<<.value is the defualt property so no need to include it in code

         For c = 4 To 303
                '.Cells(r, c).Select '<<<<best to aviod using select if you can
                'If .Cells(r, c).Value <> "" Then '<<<<<<<<MAYBE NOT NEEDED
                If InStr(.Cells(r, c), "Buy") > 0 Or InStr(.Cells(r, c), "Buy") > 0 Then  '<<<<<<<<<<<<<<<<<<< WHY ARE YOUR TWO CONDITIONS THE SAME?

                        'The first 3 cells will of each new row will be the same as the first 3 cells
                        'of current active 'original' row

                        .Cells(p, 1) = .Cells(r, 1)
                        .Cells(p, 2) = .Cells(r, 2)
                        .Cells(p, 3) = .Cells(r, 3)

                        'The active cell and the 2 cells that follow will be pasted to
                        'columns D to F in row p

                        .Cells(p, 4) = .Cells(r, c)
                        .Cells(p, 5) = .Cells(r, c + 1)
                        .Cells(p, 6) = .Cells(r, c + 2)

                        p = p + 1

                End If
                'End If
        Next c
    'Loop
    End If
Next r