CODEWITHSUNDEEP
excelexcel-2010vba
Josh McKearin
Josh McKearin

Reputation: 742

VBA Excel- Application or Object-Defined Error

Phase 1

I am attempting to search through the first column of every row in a range that has a value (formula, text, numbers, etc.) for a string. This string is generated by selecting from a drop down list. The selections are formatted like "Desktop, Dell, 790 - 4GB" and I am only concerned with the string of text before the 1st comma (AKA "Desktop" in this example.) I am using a Split() method in order to get the word before the first comma, and then attempting to use a Case statement to insert a string into another cell in the same row.

Phase 2

I am using what is selected in the first drop down list to populate a second drop down list with pre-determined values.

The Problem

The program is throwing Run-time error '1004': Application_defined or object-defined error. I don't know where to start.

Original Code

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoops
Application.EnableEvents = False
Call splitter
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
Whoops:
Application.EnableEvents = True
End Sub

Sub splitter()
   Dim line() As String
   Dim rng, row As Range
   Dim lRow, lCol As Long
   lRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).row
   lCol = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
   Set rng = Cells(lRow, lCol)

   For Each row In rng.Rows
    If row.Value <> "" Then
        line = Split(Range(row, 1), ",")
        Select Case line(0)
           Case "Desktop"
               Range(row, 8).Value = "Desktop"
           Case "Laptop"
               Range(row, 8).Value = "Laptop"
           Case "Server"
               Range(row, 8).Value = "Server"
           Case Else
               Range(row, 8).Value = "N/A"
        End Select
    End If
   Next
End Sub

Revised Code

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoops
Application.EnableEvents = False
Call splitter
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
Whoops:
Application.EnableEvents = True
End Sub

Sub splitter()
   Dim line() As String
   Dim rng As Range, row As Range
   Dim lRow As Long
   lRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).row
   Set rng = Cells("A1:N" & lRow)

   For Each row In rng.Rows
    If row.Value <> "" Then
        line = Split(Cells(row, 1), ",")
        Select Case line(0)
           Case "Desktop"
               Cells(row, 8).Value = "Desktop"
           Case "Laptop"
               Cells(row, 8).Value = "Laptop"
           Case "Server"
               Cells(row, 8).Value = "Server"
           Case Else
               Cells(row, 8).Value = "N/A"
        End Select
    End If
   Next
End Sub

Upvotes: 1

Views: 4530

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149305

I have combined your two codes into 1.

PHASE 1

Is this what you are trying?

Private Sub Worksheet_Change(ByVal Target As Range)        
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Cells.Count > 1 Then GoTo LetsContinue

        If Target.Value <> "" And InStr(1, Target.Value, ",") Then
            Select Case Split(Target.Value, ",")(0)
               Case "Desktop": Range("H" & Target.row).Value = "Desktop"
               Case "Laptop":  Range("H" & Target.row).Value = "Laptop"
               Case "Server":  Range("H" & Target.row).Value = "Server"
               Case Else:      Range("H" & Target.row).Value = "N/A"
            End Select
        End If
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        If Target.Cells.Count > 1 Then GoTo LetsContinue
        If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Upvotes: 2

Related Questions