Removing messy data

[3thr3e]

Hi,

I have created quite a long macro so I won't bore you with the details. I have just been testing it and found that due to a data discrepancy, about half way through the process cannot continue.

The sheet is the screenshot below. The stage it's getting stuck at is one where the macro goes down column E removing everything in each cell except the number in square brackets. It uses the following code:

Sub GetNums()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Range("E" & i)
.Value = Val(Mid(.Value, InStr(.Value, "[") + 1, InStr(.Value, "]") - InStr(.Value, "[") - 1))
End With
Next i
End Sub

As you can see, when it gets to the cell containing "999 Ac" it errors. This is not a normal scenario and I don't know why our system exports the line like that. It's also a duplicate entry from the table (the one directly above it) so is completely unnecessary.

I guess the solution would be to create a macro which says:

"If any of the rows in column E don't begin with "Room #9999" then delete them."

How would I implement this?

 

[pcc]

try this .NB not tested so do it on a copy of your data first!

Option compare text
Sub GetNums()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR to 1 step -1    '*****************note change here
If cells(1 , 5) like "*999 Ac" then
Rows(i).Delete
Else
With Range("E" & i)
.Value = Val(Mid(.Value, InStr(.Value, "[") + 1, InStr(.Value, "]") - InStr(.Value, "[") - 1))
End With
End if
Next i
End Sub

 

[rdw72777]

Try this:

Sub GetNums()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row

For i = 1 To LR
    With Range("E" & i)
       
        If Left(.Value, 10) <> "Room# 9999" Then
            .Value = "Error " & .Value
        Else
            .Value = Val(Mid(.Value, InStr(.Value, "[") + 1, InStr(.Value, "]") - InStr(.Value, "[") - 1))
        End If
    End With
Next i

End Sub

 

[pcc]

this is maybe better - misread your post

Option compare text
Sub GetNums()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR to 1 step -1    '*****************note change here
If Not cells(1 , 5) like "Room #9999*" then
Rows(i).Delete
Else
With Range("E" & i)
.Value = Val(Mid(.Value, InStr(.Value, "[") + 1, InStr(.Value, "]") - InStr(.Value, "[") - 1))
End With
End if
Next i
End Sub

 

[3thr3e]

This seems to have worked. Please could you explain what has changed about the process so I know for the future?

Thanks!

EDIT: Had a proper look and makes sense now. Cheers

Try this:

Sub GetNums()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
 
For i = 1 To LR
    With Range("E" & i)
 
        If Left(.Value, 10) <> "Room# 9999" Then
            .Value = "Error " & .Value
        Else
            .Value = Val(Mid(.Value, InStr(.Value, "[") + 1, InStr(.Value, "]") - InStr(.Value, "[") - 1))
        End If
    End With
Next i
 
End Sub

 

[rdw72777]

Glad to help. I'm sure you saw most of it was changuing from columns to rows and such.


One thing that always gets me, when counting rows from the bottom, the (xlUp) functionality is used but when counting columns from the right its (xltoleft). I can't tell you how often I bomb code by changing (xlup) for rows to (xlLeft) for columns when it should be (xlTOLeft).

That little different costs me about an hour a month of productivity.