Forum Discussion
itsmatta
Jun 21, 2023Copper Contributor
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
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
- JKPieterseSilver Contributor
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
- itsmattaCopper 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....
- JKPieterseSilver ContributorThat is "By design".