# Re-arranging data on a worksheet based on contents of Column A

The following Macro sorts through a worksheet, copying and removing lines based on what appears in column A. If ("A" & i) is not a number, it triggers and moves the data to the appropriate place. The script at the moment is very slow, however. Is there an easier way to achieve this?

Sub FixAbstracts()
Application.ScreenUpdating = False
Dim Rng As Range
Dim i As Long
i = 2
Dim row As Range
Dim lastRow As Long
lastRow = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

While i <= lastRow
Set Rng = Range("A" & i)
Set row = ActiveSheet.Rows(i)
lastRow = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
If Application.WorksheetFunction.IsNumber(Rng.Value) = True Then
i = i + 1

ElseIf IsNumeric(Rng.Value) = False And Application.WorksheetFunction.CountA(Rng) = 1 Then
Rng.Copy Destination:=Rng.Offset(-1, 13)
Rng.Delete Shift:=xlToLeft
ElseIf IsEmpty(Rng) = True And Application.CountA(row) > 0 Then
Rng.Delete Shift:=xlToLeft
ElseIf IsEmpty(Rng) = True And Application.CountA(row) = 0 Then
row.Delete

Else: Stop
End If
Wend

End Sub

• It is unclear to me what you actually intend to do with the four If conditions. It seems to me that there is quite some potential here by using different conditions than you use. Can you describe this in compact, natural language? Especially what should happen with numbers formatted as text? And what you want to test for with CountA(Rng)? – Leviathan May 20 '16 at 17:59
• Sure. The Four statements are very clunky, as you'll see. I'm sure there's a better way. Main aim is, if Rng is not a number, then copy and paste it across, offset(-1,13). If Rng is blank, then shift the cells to the right, until Rng becomes a number (calling the first If statement), or is not (calling the second). Last is to delete empty rows. – user1996971 May 23 '16 at 9:08

Your nesting ifs have things in common, so you can restructure it

Option Explicit
Public Sub FixAbstracts()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Dim i As Long
Dim rowCount As Long
Dim isEmptyCell As Boolean

For i = lastRow To 2 Step -1
isEmptyCell = IsEmpty(Cells(i, 1))
If isEmptyCell Then
rowCount = Application.CountA(Rows(i))
If rowCount > 0 Then Cells(i, 1).Delete xlshift:=xlToLeft
If rowCount = 0 Then Rows(i).Delete
ElseIf Not IsNumeric(Cells(i, 1)) Then
Cells(i - 1, 13) = Cells(i, 1)
Cells(i, 1).Delete xlshift:=xlToLeft
End If
Next i
End Sub


Now you have a For loop so no need to increment i.

It also steps backwards bottom to top so nothing is skipped. If you delete row(10) and go to the next row, the original row(11) is skipped. That's a result of the For loop, but it prefer it much to a Do While.

## Is it empty?

We also declared a boolean to check for empty so it's only done once per loop. Now we base our if on that to reduce multiple checks.

So now the logic is

• empty? Yes? Count the row. Now do something
• empty? No? is it a number by itself? Yes? Do something

## Is it a number?

Let's look at the logic of yours

• is it a number? yes? goto next iteration
• is it a number? no? is it empty? yes? Do something
• is it empty? yes? count the values in the row = 0 then do something
• is it empty? yes? count the values in the row > 0 then do something

See the reduction? We get rid of the initial isnumeric because the loop will iterate by itself. We also check for empty only once and we only count once.

Not to mention your code is very difficult to follow.

If Application.WorksheetFunction.IsNumber(Rng.Value) = True Then
i = i + 1

ElseIf IsNumeric(Rng.Value) = False And Application.WorksheetFunction.CountA(Rng) = 1 Then
Rng.Copy Destination:=Rng.Offset(-1, 13)
Rng.Delete Shift:=xlToLeft
ElseIf IsEmpty(Rng) = True And Application.CountA(row) > 0 Then
Rng.Delete Shift:=xlToLeft
ElseIf IsEmpty(Rng) = True And Application.CountA(row) = 0 Then
row.Delete

Else: Stop
End If


I had to reread this a bunch of times and I'm still not sure if I'm doing all the checking you are. You aren't consistent with how you're checking for a numeric value, you use a worksheet function and the vba function, there's probably no need to use the worksheet function if your data is standardized.

There's also no need to check if something like isempty = true as the result of isempty is either true or false.

• "there's no need to use the worksheet function" -- This might not be true, because the result is different for cells containing numbers formatted as text. Also see my comment to the question. – Leviathan May 20 '16 at 18:39
• Brilliant, thanks for the feedback. This works a lot better. Is it possible to adapt the line Cells(i - 1, 13) = Cells(i, 1) so I the cell is inserted into its new destination, shifting the others to the right? The aim is to keep all of the non-numeric cells in Column A on the same row as the number directly over it (I realise now that the code I posted didn't have this). Thanks again for your help, Raysta. – user1996971 May 23 '16 at 9:27
• Yeah you can add a cell and shift to the right, then target it – Raystafarian May 23 '16 at 9:38

Thanks, Raystafarian. I've adapted you're script to work with my data. I opted back to using a While loop, as I only want i to increase when Cells(i,1) is a number.

Sub FixAbstracts()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Dim i As Long
Dim rowCount As Long
Dim isEmptyCell As Boolean

i = 1

While i <= lastRow
isEmptyCell = isEmpty(Cells(i, 1))
lastRow = Cells(Rows.Count, 1).End(xlUp).row
If isEmptyCell Then
rowCount = Application.CountA(Rows(i))
If rowCount > 0 Then Cells(i, 1).Delete Shift:=xlToLeft
If rowCount = 0 Then Rows(i).Delete
ElseIf Not IsNumeric(Cells(i, 1)) Then
Cells(i - 1, 13).Insert Shift:=xlToRight
Cells(i - 1, 13) = Cells(i, 1)
Cells(i, 1).Delete Shift:=xlToLeft
Else: i = i + 1
End If
Wend
End Sub


Thanks again!