Hello! I have added in a second button that will allow the users to load the sample file onto the sample data tab, and it works exactly as I wanted. However, when I went in and added an additional tab "MRG", it no longer functions. I think I updated the code properly, and I've gone blind and insane trying to see the error, but each time I invoke the "FillTabs" macro, it stops at "Set rngMSH = Worksheets(ksWSMSH).Range(ksMSH)
" saying the range was not defined. Could you take a look and see what is the problem with this code? I've done a compare on my "works" code with "doesn't work" code and the only differences are where I have added ranges, lines, tables for MRG.
Again, my sincere thanks for your knowledge transfer on all of this. I'm trying to learn VBA on my own and you have been a huge help to me.
Option Explicit
Sub FillTabs()
'
' constants
' worksheets & ranges
' SD
Const ksWSSampleData = "Sample Data"
Const kiTitleSD = 0
Const ksTypeMSH = "MSH"
Const ksTypePID = "PID"
Const ksTypePV1 = "PV1"
Const ksTypeDG1 = "DG1"
Const ksTypeIN1 = "IN1"
Const ksTypeMRG = "MRG"
' MSH
Const ksWSMSH = "MSH"
Const ksMSH = "MSHTable"
Const kiTitleMSH = 3
' PID
Const ksWSPID = "PID"
Const ksPID = "PIDTable"
Const kiTitlePID = 3
' PV1
Const ksWSPV1 = "PV1"
Const ksPV1 = "PV1Table"
Const kiTitlePV1 = 3
' DG1
Const ksWSDG1 = "DG1"
Const ksDG1 = "DG1Table"
Const kiTitleDG1 = 3
' IN1
Const ksWSIN1 = "IN1"
Const ksIN1 = "IN1Table"
Const kiTitleIN1 = 3
' MRG
Const ksWSMRG = "MRG"
Const ksMRG = "MRGTable"
Const kiTitleMRG = 3
'
' declarations
Dim rngSD As Range
Dim rngMSH As Range, rngPID As Range, rngPV1 As Range, rngDG1 As Range, rngIN1 As Range, rngMRG As Range
Dim lSD As Long, lMSH As Long, lPID As Long, lPV1 As Long, lDG1 As Long, lIN1 As Long, lMRG As Long
Dim sType As String
'
' start
' application
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
' ranges
Set rngSD = Worksheets(ksWSSampleData).Cells
Set rngMSH = Worksheets(ksWSMSH).Range(ksMSH)
Set rngPID = Worksheets(ksWSPID).Range(ksPID)
Set rngPV1 = Worksheets(ksWSPV1).Range(ksPV1)
Set rngDG1 = Worksheets(ksWSDG1).Range(ksDG1)
Set rngIN1 = Worksheets(ksWSIN1).Range(ksIN1)
Set rngMRG = Worksheets(ksWSMRG).Range(ksMRG)
' clear
With rngMSH
If .Rows.Count > kiTitleMSH Then Range(.Rows(kiTitleMSH + 1), .Rows(.Rows.Count)).ClearContents
lMSH = kiTitleMSH
End With
With rngPID
If .Rows.Count > kiTitlePID Then Range(.Rows(kiTitlePID + 1), .Rows(.Rows.Count)).ClearContents
lPID = kiTitlePID
End With
With rngPV1
If .Rows.Count > kiTitlePV1 Then Range(.Rows(kiTitlePV1 + 1), .Rows(.Rows.Count)).ClearContents
lPV1 = kiTitlePV1
End With
With rngDG1
If .Rows.Count > kiTitleDG1 Then Range(.Rows(kiTitleDG1 + 1), .Rows(.Rows.Count)).ClearContents
lDG1 = kiTitleDG1
End With
With rngIN1
If .Rows.Count > kiTitleIN1 Then Range(.Rows(kiTitleIN1 + 1), .Rows(.Rows.Count)).ClearContents
lIN1 = kiTitleIN1
End With
With rngMRG
If .Rows.Count > kiTitleMRG Then Range(.Rows(kiTitleMRG + 1), .Rows(.Rows.Count)).ClearContents
lMRG = kiTitleMRG
End With
lSD = 1
'
' process
With rngSD
Do Until .Cells(lSD, 1).Value = "" And .Cells(lSD + 1, 1).Value = ""
' type
sType = .Cells(lSD, 1).Value
' distribute
Select Case sType
Case ksTypeMSH
lMSH = lMSH + 1
.Rows(lSD).Copy
rngMSH.Rows(lMSH).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ksTypePID
lPID = lPID + 1
.Rows(lSD).Copy
rngPID.Rows(lPID).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ksTypeDG1
lDG1 = lDG1 + 1
.Rows(lSD).Copy
rngDG1.Rows(lDG1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ksTypePV1
lPV1 = lPV1 + 1
.Rows(lSD).Copy
rngPV1.Rows(lPV1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ksTypeIN1
lIN1 = lIN1 + 1
.Rows(lSD).Copy
rngIN1.Rows(lIN1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ksTypeMRG
lMRG = lMRG + 1
.Rows(lSD).Copy
rngMRG.Rows(lMRG).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
Case ""
Case Else
MsgBox "Invalid type identifier <" & sType & "> at row " & _
lSD + kiTitleSD, vbApplicationModal + vbExclamation + vbOKOnly, _
"Warning"
End Select
' cycle
lSD = lSD + 1
Loop
End With
'
' end
' ranges
Set rngMRG = Nothing
Set rngIN1 = Nothing
Set rngDG1 = Nothing
Set rngPV1 = Nothing
Set rngPID = Nothing
Set rngMSH = Nothing
Set rngSD = Nothing
' application
With Application
.CutCopyMode = False
.DisplayAlerts = True
.ScreenUpdating = True
End With
' beep
Beep
'
End Sub
Sub ImportSample()
Dim fName As String
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt"
If fName = "False" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("$A$2"
)
.Name = "sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub