VBA - conditional error with code involving LBound(SheetNameArray) To UBound(SheetNam

[rey06]

Hi-

I have a series of macros that I used for one of my tasks. I'm having issues with the below but only in certain situations. This part of my macro breaks apart a large file based on what is in column Z, but if there is only one item in column Z, I get a mismatch error and the line "For x = LBound(SheetNameArray) To UBound(SheetNameArray)" is highlighted. I could just do the part of the macro for those and give them their own tab to begin with, but when I have several to do or if someone else would ever have to fill in, I'd like some consistency. I did test it just now to confirm that the code DOES work on those files that have more than one different string in column Z but DOES NOT work if it's all the same.

And ideas? The issue I'm having as stated above is between the "***" below.

Sub aSplitByDistributor()
Workbooks(1).Activate
Dim lastCol As Integer, LastRow As Long, x As Long
Dim rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim SheetNameArray, fn As WorksheetFunction
Dim CalcSetting As Integer
Dim newsht As Worksheet




Set fn = Application.WorksheetFunction
    ActiveWorkbook.Worksheets("Flat File").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Flat File").Sort.SortFields.Add Key:=Range( _
        "AR:AR"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        
With Sheets("Flat File")
Cells.Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
End With
End With
        
With ActiveWorkbook.Worksheets("Flat File").Sort
    .SetRange Range("A:AT")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
      
With Application
    CalcSetting = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


With Sheets("Flat File")
    Set rng = .UsedRange
    Set Rng1 = Intersect(rng, .Range("Z:Z"))
    lastCol = rng.Column + rng.Columns.Count - 1
    Rng1.Replace What:="/", Replacement:=" ", LookAt:=xlPart
     
    .Range("Z:Z").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=.Cells(1, lastCol + 2), Unique:=True
 
    Set Rng2 = Intersect(.Columns(lastCol + 2).CurrentRegion, _
    .Rows("2:" & Rows.Count))
    
    ReDim SheetNameArray(1 To Rng2.Cells.Count)
    SheetNameArray = fn.Transpose(Rng2)
    .Columns(lastCol + 2).Clear
***For x = LBound(SheetNameArray) To UBound(SheetNameArray)***
    On Error Resume Next
    Set newsht = ThisWorkbook.Sheets(Left(SheetNameArray(x), 31))
        If Err <> 0 Then
            Worksheets.Add
            ActiveSheet.Name = Left(SheetNameArray(x), 31)
            Err.Clear
        End If
                     
        On Error GoTo 0
            rng.AutoFilter Field:=26, Criteria1:=SheetNameArray(x)
            Set Rng3 = Intersect(rng, .Cells.SpecialCells(xlCellTypeVisible))
            Rng3.Copy Workbooks(1).Sheets(Left(SheetNameArray(x), 31)).Range("A1")
            rng.AutoFilter
    Cells.EntireColumn.AutoFit
  Next x
End With


Range("A1").Select
Application.Calculation = CalcSetting
    Sheets(Array("MACROS", "Flat File")).Select
    Sheets("Flat File").Activate
    Sheets(Array("MACROS", "Flat File", "DisReport", "DisInput")).Move Before:=Sheets(1)
Sheets("MACROS").Select
 
End Sub

[SamT]

Set Rng2 = Cells(2, lastCol + 2)
Set Rng2 = Range(Rng2, Cells(Rows.Count, Rng2.Column).End(xlUp))

          If Rng2.Count = 1 Then 
             MakeSheet Rng2
          Else        
            ReDim SheetNameArray(1 To Rng2.Cells.Count) 
                SheetNameArray = fn.Transpose(Rng2) 
               Rng2.Clear 
               For x = LBound(SheetNameArray) To UBound(SheetNameArray)*** 
                  MakeSheet SheetNameArray(x)
               Next
           End If
End Sub

Private Sub MakeSheet(ShtName As String)
   Dim newsht as Worksheet
       On Error GoTo SubEnd
        Set newsht = ThisWorkbook.Sheets(Left(ShtName, 31)) 
  
        Worksheets.Add 
        ActiveSheet.Name = Left(shtName, 31) 

SubEnd:
End Sub

[rey06]

Hi Sam, thanks for the response.

Do I just replace the top box with the bottom?

[SamT]

No. Those were just to give you a different idea about how to rewrite your code. You still need to move the Rng3.Copy section to it's own Sub and call it every time Rng2 is accessed.

Sub CopyData(NewSht As WorkSheet)
With ThisWorkbook.UsedRange       
 .AutoFilter Field:=26, Criteria1:=SheetNameArray(x) 
.Cells.SpecialCells(xlCellTypeVisible).Copy NewSht.Range("A1") 
 .AutoFilter 
.Cells.EntireColumn.AutoFit 
End With
End Sub

I think that if you figure out what my code does, you can integrate it into your code. Anyway. The boss is here, Gotta run. HTH you.

[rey06]

Sorry for not getting to this sooner. Busy week last week. I'm trying out the first code you suggested, and I'm getting stuck on the MakeSheet line. (Compile error: Sub or Function not defined).

[SamT]

The Running sub can't find MakeSheet. Are they in the same module? If not MakeSheet must be Public

[rey06]

Yeah, it's all in the same module. I think I just might make a note that if there is only one distributor to place it on it's own tab. I have this whole thing set up with 6 different buttons and one master that calls them all. Might be easier just to not try to incorporate this into my existing code.

[SamT]

6 different buttons and one master that calls them all.

I don't understand what that means.

[rey06]

6 different buttons and one master that calls them all.

I don't understand what that means.

Long story short, I just kept adding to what I wanted to be done with this file I get. It started out that I just wanted a quicker way to break my file apart by distributor, but then I realized I could do a whole lot more. Instead of having one large code to do everything, I just kept writing new codes. Each of these codes does it's own part and I have a button for each one to make it as easy as possible for someone else to jump into. Made it easier to debug along the way! If I want to just run them all, I made another button that just runs all three codes in order. I probably way over complicated it, but I literally just started using VBA within the last 2 months I just don't know if it's worth going through the hassle for something that doesn't happen all that often. But I appreciate the suggestions! I just can't seem to make anything work.