Solved

Debug issue in Excel 2010 macro

Posted on 2014-11-19
7
101 Views
Last Modified: 2014-11-20
The macro stops at this line:

     If cl.Offset(0, 1).Value <> "" Then intBed = Int(Mid(cl.Offset(0, 1), InStr(1, cl.Offset(0, 1).Value, ":") + 2))

Entire macro is here:
Sub Transpose_Listings()
    Dim cl As Range, rgLookup As Range, rng As Range
    Dim strAddress As String, strSub As String, strType As String, strMonth As String
    Dim intBed As Integer, intBath As Integer, intCar As Integer, intYear As Integer
    Dim Postcode As Variant, v As Variant, varPrice As Variant
    Dim intRow As Long
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    Set rng = Worksheets(1).Range("A2:A" & Worksheets(1).Cells.SpecialCells(xlLastCell).Row)
    Set rgLookup = Worksheets("Postcode & Suburb List").Range("A1").CurrentRegion
   
    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Results"
    Range("A1:J1").Value = Array("Address", "Suburb", "Postcode", "Bed", "Bath", "Car", "Type", "Month", "Year", "Price")
    intRow = 2
   
    For Each cl In rng
        Select Case LCase(cl.Value)
            Case "address" 'start of data block
                'skip
            Case "date and price list"
                'skip
            Case "date"
                'skip
            Case ""
                'skip
            Case Else
                If IsDate(cl.Value) Then            'pricing data - write to Results sheet
                    v = CDate(cl.Value)
                    strMonth = Format(v, "mmmm")
                    intYear = Year(v)
                    If InStr(1, cl.Offset(0, 1).Value, " ") = 0 Then
                        varPrice = cl.Offset(0, 1).Value
                    Else
                        varPrice = Val(Mid(cl.Offset(0, 1).Value, 2, InStr(1, cl.Offset(0, 1).Value, " ") - 1))
                    End If
                    With Sheets("Results")
                        .Cells(intRow, 1).Resize(1, 10).Value = _
                            Array(strAddress, strSub, Postcode, intBed, intBath, intCar, strType, strMonth, intYear, varPrice)
                    End With
                    intRow = intRow + 1
                Else
                    intBed = 0
                    intBath = 0
                    intCar = 0
                    strAddress = Left(cl.Value, InStrRev(cl.Value, ",") - 1)
                    strSub = Mid(cl.Value, InStrRev(cl.Value, ",") + 2)
                    Postcode = Application.Match(strSub, rgLookup.Columns(2), 0)
                    Postcode = IIf(IsError(Postcode), "", rgLookup.Cells(CLng(Postcode), 1).Value)
                    If cl.Offset(0, 1).Value <> "" Then intBed = Int(Mid(cl.Offset(0, 1), InStr(1, cl.Offset(0, 1).Value, ":") + 2))
                    If cl.Offset(0, 2).Value <> "" Then intBath = Int(Mid(cl.Offset(0, 2), InStr(1, cl.Offset(0, 2).Value, ":") + 2))
                    If cl.Offset(0, 3).Value <> "" Then intCar = Int(Mid(cl.Offset(0, 3), InStr(1, cl.Offset(0, 3).Value, ":") + 2))
                    strType = cl.Offset(0, 4).Value
                End If
        End Select
    Next cl
   
    With Sheets("Results")
        .Range("A:G").EntireColumn.AutoFit
        .Range("I2:I" & intRow).NumberFormat = "$#,##0"
    End With
   
    RemoveDuplicates
   
    Application.DisplayAlerts = True
    MsgBox "Done."
End Sub

Private Sub RemoveDuplicates()
    Application.CutCopyMode = False
    Worksheets("Results").UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes
End Sub

                                         
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
Select all
Open in new window
3207a.xlsm
0
Comment
Question by:gregfthompson
  • 4
  • 3
7 Comments
 
LVL 33

Expert Comment

by:Norie
ID: 40454310
Does it stop due to an error?

If it does, what's the error message?
0
 

Author Comment

by:gregfthompson
ID: 40454335
There is no error message. It stops at this line according to the debug window:

  If cl.Offset(0, 1).Value <> "" Then intBed = Int(Mid(cl.Offset(0, 1), InStr(1, cl.Offset(0, 1).Value, ":") + 2))
0
 

Author Comment

by:gregfthompson
ID: 40454336
PS: Have you tried running the macro in the attached file?
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 33

Expert Comment

by:Norie
ID: 40454342
Try this.
Sub Transpose_Listings()
Dim cl As Range, rgLookup As Range, rng As Range
Dim strAddress As String, strSub As String, strType As String, strMonth As String
Dim intBed As Integer, intBath As Integer, intCar As Integer, intYear As Integer
Dim Postcode As Variant, v As Variant, varPrice As Variant
Dim intRow As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set rng = Worksheets(1).Range("A2:A" & Worksheets(1).Cells.SpecialCells(xlLastCell).Row)
    Set rgLookup = Worksheets("Postcode & Suburb List").Range("A1").CurrentRegion

    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Results"
    Range("A1:J1").Value = Array("Address", "Suburb", "Postcode", "Bed", "Bath", "Car", "Type", "Month", "Year", "Price")
    intRow = 2

    For Each cl In rng
        Select Case LCase(cl.Value)
            Case "address"    'start of data block
                'skip
            Case "date and price list"
                'skip
            Case "date"
                'skip
            Case ""
                'skip
            Case Else
                If IsDate(cl.Value) Then            'pricing data - write to Results sheet
                    v = CDate(cl.Value)
                    strMonth = Format(v, "mmmm")
                    intYear = Year(v)
                    If InStr(1, cl.Offset(0, 1).Value, " ") = 0 Then
                        varPrice = cl.Offset(0, 1).Value
                    Else
                        varPrice = Val(Mid(cl.Offset(0, 1).Value, 2, InStr(1, cl.Offset(0, 1).Value, " ") - 1))
                    End If
                    With Sheets("Results")
                        .Cells(intRow, 1).Resize(1, 10).Value = _
                        Array(strAddress, strSub, Postcode, intBed, intBath, intCar, strType, strMonth, intYear, varPrice)
                    End With
                    intRow = intRow + 1
                Else
                    intBed = 0
                    intBath = 0
                    intCar = 0
                    strAddress = Left(cl.Value, InStrRev(cl.Value, ",") - 1)
                    strSub = Mid(cl.Value, InStrRev(cl.Value, ",") + 2)
                    Postcode = Application.Match(strSub, rgLookup.Columns(2), 0)
                    Postcode = IIf(IsError(Postcode), "", rgLookup.Cells(CLng(Postcode), 1).Value)
                    If cl.Offset(0, 1).Value <> "" Then intBed = Int(Mid(cl.Offset(0, 1), InStr(cl.Offset(0, 1).Value, ":") + 1))
                    If cl.Offset(0, 2).Value <> "" Then intBath = Int(Mid(cl.Offset(0, 2), InStr(cl.Offset(0, 2).Value, ":") + 1))
                    If cl.Offset(0, 3).Value <> "" Then intCar = Int(Mid(cl.Offset(0, 3), InStr(cl.Offset(0, 3).Value, ":") + 1))
                    strType = cl.Offset(0, 4).Value
                End If
        End Select
    Next cl

    With Sheets("Results")
        .Range("A:G").EntireColumn.AutoFit
        .Range("I2:I" & intRow).NumberFormat = "$#,##0"
    End With

    RemoveDuplicates

    Application.DisplayAlerts = True
    MsgBox "Done."
End Sub

Open in new window

0
 

Author Comment

by:gregfthompson
ID: 40454403
Thanks.  It appeared to work then stopped.

I've attached the file and a screenshot of the error.
3207macro-compile-error.xlsm
Compile-error.JPG
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 40454407
Did you remove this RemoveDuplicates sub?
Private Sub RemoveDuplicates()
    Application.CutCopyMode = False
    Worksheets("Results").UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes
End Sub

Open in new window

0
 

Author Closing Comment

by:gregfthompson
ID: 40454444
Thanks. It now works.  I don't know what I did.,

Thanks again.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
My experience with Windows 10 over a one year period and suggestions for smooth operation
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now