PDA

View Full Version : Run-time error '1004 Application-defined or object-defined error



anthony20069
02-04-2013, 09:19 AM
Hi guys,

Ive started to get this lovely error as in the title now. I have the following:

Private Sub btnValueSearch_Click()



Dim wsResults As Worksheet

Dim wsCSV As Worksheet
Dim rValues As Range
Dim rFrom As Range
Dim wbValues As Workbook
Dim rTo As Range
Dim c1 As Range
Dim c2 As Range
Dim rCopy As Range
Dim vcol
Dim i
Dim aHeaders As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim c3 As Range
Dim c4 As Range
Dim aColumns() As Variant
Dim iLast_row
Dim iLast_rowArray



'function to define what values to be used in the array
definearray

Workbooks("Data_Transformer.xlsm").Activate
With ActiveSheet
'
aHeaders = aMyArray

ReDim aColumns(UBound(aHeaders) - 1)


End With

'

'Sets to the current active workbook
Set wbValues = ThisWorkbook

Set wbFrom = Workbooks.Open(Application.GetOpenFilename _
(MultiSelect:=False))


AddTemplate

'Sets the range - edit to define the new column the search criteria will be
Set rValues = wbValues.Sheets("Template").Columns(6).SpecialCells(2)



'Sets the active sheet to work off of, change to required naming format
FindWorksheet
Set wsFrom = wbFrom.Sheets(iWorkSheets)


'find the last row to make the data range
iLast_row = wsFrom.Cells(Rows.Count, "A").End(xlUp).Row


'Sets the Template Sheet to be copied into CSV file
Set wsCSV = wbFrom.Sheets("Template")


'Past the found values(when found) into the Sheet("template") starting from row 6 column 4
Set rTo = wsCSV.Cells(6, 6)

'Go to this function to convert numbers to characters for the range being used


'Sets the range to search the criteria in the opened file

Set rFrom = Intersect(wsFrom.Range(sMinColumnLetter & "2:" & sMaxColumnLetter & iLast_row), wsFrom.UsedRange)


'Switch back to the wbFrom workbook
wbFrom.Activate

Set rFrom = rFrom.SpecialCells(2)

'This loop looks for the headers set in the array above then copies the value
With wsFrom
'find the column names
y = 0
For Each c3 In Intersect(.UsedRange, .Rows(1))
For x = LBound(aHeaders) To UBound(aHeaders)
If c3 = aHeaders(x, 1) Then
aColumns(y) = c3.Column
y = y + 1
End If
Next x
Next c3
End With

'Copy and paste values
For Each c1 In rValues.Cells
For Each c2 In rFrom.Cells
If c2.Value Like "*" & c1.Value & "*" Then
rTo = c1.Value
With wsFrom
Set rCopy = Nothing
For x = LBound(aColumns) To UBound(aColumns)
If rCopy Is Nothing Then
Set rCopy = .Cells(c2.Row, aColumns(x))
Else
Set rCopy = Union(rCopy, .Cells(c2.Row, aColumns(x))) 'THIS IS WHERE DEBUG POINTS TO IT FAILING :(
End If
Next x
y = 1
For Each c4 In rCopy.Cells
rTo.Offset(0, y) = c4
y = y + 1
Next c4
y = 0
Set rTo = rTo.Offset(1, 0)
End With
End If
Next c2
Next c1

AddSwitchZone

With ActiveSheet
'Delete the Search Criteria Column
.Columns("F:F").Select
Selection.Delete Shift:=xlToLeft

'Delete rows 1 - 4 before saving as CSV
.Rows("1:4").Select
Selection.Delete Shift:=xlUp

End With


Workbooks("Data_Transformer.xlsm").Worksheets("Template").Activate
With ActiveSheet
'Clears out the data in the Template File to be used again
.Rows("F6").Select
.Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

End With



'saves to CSV file and also removes all duplicate values
With wsCSV
ReDim vcol(.UsedRange.Columns.Count - 1)
For i = 1 To .UsedRange.Columns.Count
vcol(i - 1) = i
Next

.Range(.UsedRange.Address).RemoveDuplicates Columns:=Evaluate(vcol), Header:=xlNo
.SaveAs svpth & "\output.csv", xlCSV
End With

wbFrom.Close (False)


End Sub
I can only guess and say its because of the Range i have introduced into the array somehow is breaking.

Any help would be greatly appreciated

Kenneth Hobs
02-04-2013, 09:36 AM
Use F8 to debug a line at a time or go into Debug at run-time. You have nothing in a range or a workbook or worksheet does not exist.