PDA

View Full Version : Subscript out of range error in VBA code



ARNG
11-05-2019, 02:21 PM
Hi,

When i wrote the code to copy multiple text files into one excel sheet, I am getting an error "Subscription out of range" error at the line in bold below


***Here is my code below***


Sub importfiles()
'
' importfiles Macro


For rep = 4 To 7


Dim file_name As String
Dim row_number As String
Dim output_sheet As String
file_name = Sheets("Admin").Range("B" & rep).Value
output_sheet = Sheets("Admin").Range("C" & rep).Value
row_number = Sheets("Admin").Range("D" & rep).Value

With Sheets(output_sheet).QueryTables.Add(Connection:="TEXT;" + file_name, Destination:=Sheets(output_sheet).Range("$A$" + row_number))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileFixedColumnWidths = Array(10, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Dim wb_connection As WorkbookConnection
For Each wb_connection In ActiveWorkbook.Connections
If InStr(file_name, wb_connection.Name) > 0 Then
wb_connection.Delete
End If
Next wb_connection

Next rep


End Sub

Could anyone help me with this?

Leith Ross
11-05-2019, 03:48 PM
Hello ARNG,

You Dimensioned OutputSheet As a Range, not as a Worksheet. Try this...


Sub importfiles()
'
' importfiles Macro


Dim file_name As String
Dim row_number As String
Dim output_sheet As Worksheet
Dim wb_connection As WorkbookConnection


Set output_sheet = Sheets("output_sheet")

For rep = 4 To 7
file_name = Sheets("Admin").Range("B" & rep).Value
'output_sheet = Sheets("Admin").Range("C" & rep).Value
row_number = Sheets("Admin").Range("D" & rep).Value


With output_sheet.QueryTables.Add(Connection:="TEXT;" & file_name, Destination:=output_sheet.Range("$A$" & row_number))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileFixedColumnWidths = Array(10, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With


For Each wb_connection In ActiveWorkbook.Connections
If InStr(file_name, wb_connection.Name) > 0 Then
wb_connection.Delete
End If
Next wb_connection
Next rep


End Sub

SamT
11-05-2019, 07:57 PM
@ Leith, Output_Sheet is a string, = to Sheets("Admin").Range("C" & rep).Value

@ AENG,
make sure that Sheets("Admin").Range("C" & rep) always contains a real Sheet Name. Also, "rep" is not explicitly Declared.

Is Sheets("Admin").Range("C" & rep) a number or a String? If a number, declare Output_Sheet as a Long. If a String, try using

output_sheet = Sheets("Admin").Range("C" & rep).Text

webmaster62
11-06-2019, 08:20 AM
After [Next Rep], put [Set output_sheet=Nothing] and your code should work easily.

paulked
11-06-2019, 10:27 AM
@webmaster62
I tried that with this code and it worked easily:



Sub CastSpell(Name1 As String, Name2 As String, Spell As String)
Dim i As Long, ws As Worksheet
Set ws = Sheet1
i = 1
MsgBox i & ". " & Name1
i = i + 1
MsgBox i & ". " & Name2
i = i + 1
MsgBox i & ". " & Spell & " --- " & Name1 & " " & Name2
Set ws = Nothing
End Sub


Sub SpellA()
CastSpell "Harry", "Potter", "Producto Namos"
End Sub




But not for this code:



Sub Spell()
For Each Spell In SpellBook
Do Until Name = True
Try Spell
Loop
Next
Set Spell = Nothing
End Sub



:dunno