Forum Discussion

itsmatta's avatar
itsmatta
Copper Contributor
Jun 21, 2023
Solved

Excel VBA assistance and storing formulas in a table

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

 

  • 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

  • JKPieterse's avatar
    JKPieterse
    Silver Contributor

    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

    • itsmatta's avatar
      itsmatta
      Copper Contributor

      JKPieterse 

      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....

       

Resources