4
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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)? \$\endgroup\$ – Leviathan May 20 '16 at 17:59
  • \$\begingroup\$ 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. \$\endgroup\$ – user1996971 May 23 '16 at 9:08
1
\$\begingroup\$

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.

|improve this answer|||||
\$\endgroup\$
  • \$\begingroup\$ "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. \$\endgroup\$ – Leviathan May 20 '16 at 18:39
  • \$\begingroup\$ 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. \$\endgroup\$ – user1996971 May 23 '16 at 9:27
  • 1
    \$\begingroup\$ Yeah you can add a cell and shift to the right, then target it \$\endgroup\$ – Raystafarian May 23 '16 at 9:38
0
\$\begingroup\$

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!

|improve this answer|||||
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.