SOLVED

Excel VBA assistance and storing formulas in a table

Copper Contributor

Had someone assist with creating a macro to generate files. The person is no longer reachable and I feel like this is something simple I'm over looking. First off when the files are generated it follows a numbering scheme 001, 002, etc. Well, when it reaches 100 it does 0100, 0101...which I don't want.

 

Also, there were formulas stored in the table. When I input data into the first column, it will auto-populate the row based on the formulas. I can't modify the formulas because they aren't visible until I input data into the first cell, which is annoying. Any assistance is greatly appreciated :)

Sub CheckForTypearray()
Dim Startrange As Integer
Startrange = 2
Dim array192() As Variant
Dim arraylength As Integer
Dim path As String
Dim filenameNEW As String
Dim newfn As String
path = Sheet3.Range("C7")
Dim specialcharacters As String
specialcharacters = "-,.,_,$,%,^,&,*,(,),{,[,<,>,?"

Call DirectoryCreate(path & "2.0")
Call DirectoryCreate(path & "2.6")

For Each x In Sheet3.ListObjects("tbl_IDGenerator").ListColumns("Type").DataBodyRange
    If x.Offset(0, 1) = 2.6 And x.Offset(0, 4) = "" Then
        If x = 192 Then
            arraylength = 6 * x.Offset(0, 2) * 2
            ReDim Preserve array192(arraylength)
            Z = 0
        For D = 1 To x.Offset(0, 2)
            For y = 1 To 6
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "a"
                Z = Z + 1
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "b"
                Z = Z + 1
                Startrange = Startrange + 2
            Next y
        Next D
        filenameNEW = x.Offset(0, 5)
        
        Workbooks.Add
        Range("B1:B" & arraylength) = Application.Transpose(array192)
        
        ActiveWorkbook.SaveAs Filename:=path & "2.6\" & filenameNEW & ".CSV", FileFormat:=xlCSV
          
        ActiveWorkbook.Close
        Erase array192()
        
        End If
      If x = 96 Then
          arraylength = 6 * x.Offset(0, 2) * 2
          ReDim Preserve array192(arraylength)
          Z = 0
          For D = 1 To x.Offset(0, 2)
              For y = 1 To 6
                  array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "a"
                  Z = Z + 1
                  array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "b"
                  Z = Z + 1
                  Startrange = Startrange + 2
              Next y
          Next D
          filenameNEW = x.Offset(0, 5)
      
          Workbooks.Add
          Range("B1:B" & arraylength) = Application.Transpose(array192)
    
          Range("K1") = "=MID($B$1,15,1)"
    
          If Range("K1") = 2 Then
                Range("B1:B48").EntireRow.Delete
          Else
                Range("B49:B96").EntireRow.Delete
          End If
          Range("K1").Delete
     
          ActiveWorkbook.SaveAs Filename:=path & "2.6\" & filenameNEW & ".CSV", FileFormat:=xlCSV
          ActiveWorkbook.Close
          Erase array192()
      
      End If
    End If
    
    
    ' This is if2.0 start number is not <>
    
    If x.Offset(0, 1) = 2.6 And x.Offset(0, 4) <> "" Then
    If x = 192 Then
        arraylength = 6 * x.Offset(0, 2) * 2
        ReDim Preserve array192(arraylength)
        Z = 0
        For D = 1 To x.Offset(0, 2)
            For y = 1 To 6
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "a"
                Z = Z + 1
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "b"
                Z = Z + 1
                Startrange = Startrange + 2
            Next y
        Next D
        filenameNEW = x.Offset(0, 5)
        Workbooks.Add
        Range("B1:B" & arraylength) = Application.Transpose(array192)
        Range("B" & x.Offset(0, 4) & ":B" & arraylength).EntireRow.Delete
        ActiveWorkbook.SaveAs Filename:=path & "2.6\" & filenameNEW & ".CSV", FileFormat:=xlCSV
        ActiveWorkbook.Close
        Erase array192()
 
 
    
        ReDim Preserve array192(arraylength)
        Z = 0
        For D = x.Offset(0, 4) To arraylength
            If D < 10 Then
                array192(Z) = x.Offset(0, -1) & "00" & D
                Z = Z + 1
            Else
                array192(Z) = x.Offset(0, -1) & "0" & D
                Z = Z + 1
            End If
        Next D
        filenameNEW = x.Offset(0, 5)

        Workbooks.Add
        Range("B1:B" & arraylength) = Application.Transpose(array192)
   
        ActiveWorkbook.SaveAs Filename:=path & "2.0\" & filenameNEW & ".CSV", FileFormat:=xlCSV
        ActiveWorkbook.Close
        Erase array192()
    End If
    
    'This is the end of 2.0 start number
    'This is the start of 96
    
    If x = 96 Then
        arraylength = 6 * x.Offset(0, 2) * 2
        ReDim Preserve array192(arraylength)
        Z = 0
        For D = 1 To x.Offset(0, 2)
            For y = 1 To 6
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "a"
                Z = Z + 1
                array192(Z) = x.Offset(0, -1) & "D" & D & "." & "L" & y & "." & "b"
                Z = Z + 1
                Startrange = Startrange + 2
            Next y
        Next D
        filenameNEW = x.Offset(0, 5)
    
        Workbooks.Add
        Range("B1:B" & arraylength) = Application.Transpose(array192)
        Range("K1") = "=MID($B$1,15,1)"
  
        If Range("K1") = 2 Then
            Range("B1:B48").EntireRow.Delete
               Else
            Range("B49:B96").EntireRow.Delete
        End If
        Range("K1").Delete
   
        Range("B" & x.Offset(0, 4) & ":B" & arraylength).EntireRow.Delete
            
        ActiveWorkbook.SaveAs Filename:=path & "2.6\" & filenameNEW & ".CSV", FileFormat:=xlCSV
        ActiveWorkbook.Close
        Erase array192()
        
         
        ReDim Preserve array192(arraylength)
        Z = 0
        For D = x.Offset(0, 4) To arraylength
            If D < 10 Then
                array192(Z) = x.Offset(0, -1) & "00" & D
                Z = Z + 1
            Else
                array192(Z) = x.Offset(0, -1) & "0" & D
                Z = Z + 1
            End If
        Next D
        filenameNEW = x.Offset(0, 5)

        Workbooks.Add
        Range("B1:B" & arraylength) = Application.Transpose(array192)
  
 
        ActiveWorkbook.SaveAs Filename:=path & "2.0\" & filenameNEW & ".CSV", FileFormat:=xlCSV
        ActiveWorkbook.Close
        Erase array192()
    End If
  End If
    'This is the end of 96
    
    If x.Offset(0, 1) = 2 Then
        arraylength = x.Offset(0, 3)
        ReDim Preserve array192(arraylength)
        Z = 0
     For D = 1 To x.Offset(0, 3)
        If D < 10 Then
           array192(Z) = x.Offset(0, -1) & "00" & D
           Z = Z + 1
        Else
           array192(Z) = x.Offset(0, -1) & "0" & D
           Z = Z + 1
        End If
    Next D
     filenameNEW = x.Offset(0, 5)

    Workbooks.Add
    Range("B1:B" & arraylength) = Application.Transpose(array192)
    ActiveWorkbook.SaveAs Filename:=path & "2.0\" & filenameNEW & ".CSV", FileFormat:=xlCSV
    ActiveWorkbook.Close
    Erase array192()
    End If
Next x
    

MsgBox "Generate And Save Is Complete"


End Sub

 

3 Replies
best response confirmed by itsmatta (Copper Contributor)
Solution

@itsmatta 

To fix the numbering, change this bit:

            If D < 10 Then
                array192(Z) = x.Offset(0, -1) & "00" & D
                Z = Z + 1
            Else
                array192(Z) = x.Offset(0, -1) & "0" & D
                Z = Z + 1
            End If

 

To this:

 

                array192(Z) = x.Offset(0, -1) & Format(D,"0000")

 

You cannot change the way tables work, to edit their column formulas you must have at least one row with content in any of the cells. When editing a column formula, make sure that:

- The table has at least two rows

- When you edit a formula, make sure to copy it across all rows of that column

@Jan Karel Pieterse 

That code worked! Thank you! 

 

I don't think I explain well on the table part. So I'll include photos:

When cell I15 is selected. No formula is displayed. Once data is inputted into cell C15, I15 auto-populates a formula. He said the formula is stored in the table....

itsmatta_0-1687361591118.pngitsmatta_1-1687361627664.png

 

That is "By design".
1 best response

Accepted Solutions
best response confirmed by itsmatta (Copper Contributor)
Solution

@itsmatta 

To fix the numbering, change this bit:

            If D < 10 Then
                array192(Z) = x.Offset(0, -1) & "00" & D
                Z = Z + 1
            Else
                array192(Z) = x.Offset(0, -1) & "0" & D
                Z = Z + 1
            End If

 

To this:

 

                array192(Z) = x.Offset(0, -1) & Format(D,"0000")

 

You cannot change the way tables work, to edit their column formulas you must have at least one row with content in any of the cells. When editing a column formula, make sure that:

- The table has at least two rows

- When you edit a formula, make sure to copy it across all rows of that column

View solution in original post