VB Script Simplification for "offset" repeating numbers?

Question

I have a script I use to inspect parts, or "Apertures":

In the program I'm using, there's a separate script at the start where the user defines what number aperture they are inspecting in a sequence. So this number is always defined at the start of the program. Depending on which aperture you are inspecting, the measurement results are pasted within a column in excel:

'The naming scheme is aperture(Number)D(Dimension number)N(Number of measurement for the same dimension)

'Distance
   Dim1Num1 = GetReportInfo("DIST BT Left_Side" & elipsis & " and Right_Side" & elipsis, "XY", 2)
   Dim1Num2 = GetReportInfo("DIST BT LBC" & elipsis & " and RBC" & elipsis, "XY", 2)
   Dim2Num1 = GetReportInfo("DIST BT TLine" & elipsis & " and BLine" & elipsis, "XY", 2)
   Dim2Num2 = GetReportInfo("DIST BT LLine" & elipsis & " and RLine" & elipsis, "XY", 2)
   Dim3Num1 = GetReportInfo("DIST BT TTC" & elipsis & " and BBC" & elipsis, "XY", 2)
   Dim3Num2 = GetReportInfo("DIST BT LTC" & elipsis & " and RTC" & elipsis, "XY", 2)
   Dim4Num1 = GetReportInfo("DIST BT Left" & elipsis & " and Right" & elipsis, "XY", 2)
   Dim4Num2 = GetReportInfo("DIST BT Top" & elipsis & " and Bottom" & elipsis, "XY", 2)
   Dim5Num1 = InputBox("Does the part have orientation dots?", "Dimension 5")
   If aperture = 1 Or aperture = 7 Or aperture = 13 Or aperture = 19 Or aperture = 25 Then
      ' Record all aperture 1 measurements
      xlsWS.Cells(9, 6).value = Dim1Num1
      xlsWS.Cells(10, 6).value = Dim1Num2
      xlsWS.Cells(11, 6).value = Dim2Num1
      xlsWS.Cells(12, 6).value = Dim2Num2
      xlsWS.Cells(13, 6).value = Dim3Num1
      xlsWS.Cells(14, 6).value = Dim3Num2
      xlsWS.Cells(15, 6).value = Dim4Num1
      xlsWS.Cells(16, 6).value = Dim4Num2
      xlsWS.Cells(17, 6).value = Dim5Num1
      xlsWB.Save
   ElseIf aperture = 2 Or aperture = 8 Or aperture = 14 _
                       Or aperture = 20 Or aperture = 26 Then
      ' Record all aperture 2 measurements
      xlsWS.Cells(9, 7).value = Dim1Num1
      xlsWS.Cells(10, 7).value = Dim1Num2
      xlsWS.Cells(11, 7).value = Dim2Num1
      xlsWS.Cells(12, 7).value = Dim2Num2
      xlsWS.Cells(13, 7).value = Dim3Num1
      xlsWS.Cells(14, 7).value = Dim3Num2
      xlsWS.Cells(15, 7).value = Dim4Num1
      xlsWS.Cells(16, 7).value = Dim4Num2
      xlsWS.Cells(17, 7).value = Dim5Num1
      xlsWB.Save
   ElseIf aperture = 3 Or aperture = 9 Or aperture = 15 _
                       Or aperture = 21 Or aperture = 27 Then
      ' Record all aperture 1 measurements
      xlsWS.Cells(9, 8).value = Dim1Num1
      xlsWS.Cells(10, 8).value = Dim1Num2
      xlsWS.Cells(11, 8).value = Dim2Num1
      xlsWS.Cells(12, 8).value = Dim2Num2
      xlsWS.Cells(13, 8).value = Dim3Num1
      xlsWS.Cells(14, 8).value = Dim3Num2
      xlsWS.Cells(15, 8).value = Dim4Num1
      xlsWS.Cells(16, 8).value = Dim4Num2
      xlsWS.Cells(17, 8).value = Dim5Num1
      xlsWB.Save
   ElseIf aperture = 4 Or aperture = 10 Or aperture = 16 _
                       Or aperture = 22 Or aperture = 28 Then
      xlsWS.Cells(9, 9).value = Dim1Num1
      xlsWS.Cells(10, 9).value = Dim1Num2
      xlsWS.Cells(11, 9).value = Dim2Num1
      xlsWS.Cells(12, 9).value = Dim2Num2
      xlsWS.Cells(13, 9).value = Dim3Num1
      xlsWS.Cells(14, 9).value = Dim3Num2
      xlsWS.Cells(15, 9).value = Dim4Num1
      xlsWS.Cells(16, 9).value = Dim4Num2
      xlsWS.Cells(17, 9).value = Dim5Num1
      xlsWB.Save
   ElseIf aperture = 5 Or aperture = 11 Or aperture = 17 _
                       Or aperture = 23 Or aperture = 29 Then
      xlsWS.Cells(9, 10).value = Dim1Num1
      xlsWS.Cells(10, 10).value = Dim1Num2
      xlsWS.Cells(11, 10).value = Dim2Num1
      xlsWS.Cells(12, 10).value = Dim2Num2
      xlsWS.Cells(13, 10).value = Dim3Num1
      xlsWS.Cells(14, 10).value = Dim3Num2
      xlsWS.Cells(15, 10).value = Dim4Num1
      xlsWS.Cells(16, 10).value = Dim4Num2
      xlsWS.Cells(17, 10).value = Dim5Num1
      xlsWB.Save
   ElseIf aperture = 6 Or aperture = 12 Or aperture = 18 _
                       Or aperture = 24 Or aperture = 30 Then
      xlsWS.Cells(9, 11).value = Dim1Num1
      xlsWS.Cells(10, 11).value = Dim1Num2
      xlsWS.Cells(11, 11).value = Dim2Num1
      xlsWS.Cells(12, 11).value = Dim2Num2
      xlsWS.Cells(13, 11).value = Dim3Num1
      xlsWS.Cells(14, 11).value = Dim3Num2
      xlsWS.Cells(15, 11).value = Dim4Num1
      xlsWS.Cells(16, 11).value = Dim4Num2
      xlsWS.Cells(17, 11).value = Dim5Num1
      xlsWB.Save
   End If

As you can see, there's a pattern. What I'm doing is saying if I have "X" aperture, then the measurements need to be placed in "X" column in Excel.

The Excel workbook cannot change. it always is columns 6 to 11, and so far I only have it setup to measure up to 30 apertures.

after the "6th" aperture is measured (Column 11). The next measurement' starting script will open and rename a new workbook. resetting the column to "6"

So if I have aperture "1" it would be Column 6 in workbook1. Aperture "7" is also column 6 but workbook2. and so on. Because "7" would create a new workbook and restart the column order.

As you can see in the script. I've so far gotten around this by just using "OR" and defining which aperture goes into which column.

I would prefer to somehow shorten this.

I tried changing the column so it's based on the aperture#. xlsWS.cells(9, (aperture + 5).Value = Dim1Num1 but obviously when you get to the second workbook this fails, as the columns reset.

I think using an infinite variable so the maximum is not set to 30 also would help. An exponent with a variable? (6^x) being 6^1 OR 6^2 and so on, but im not sure how to make the connection of "If aperture = 6^x Then" because id still need to define X.

In a perfect world I would solve both problems.

Allow an infinite number of apertures to be inspected, with the program properly attributing it to the correct column 2.Be able to use a single block of code to define which column to paste the information to. Instead of defining column 6 through 11. As the variable of information "Dim(x)Num(x)" doesn't change.

Étienne Laneville · Answer 1 · 2023-07-07T18:11:12.673

You can start by breaking down the code that updates the Worksheet into a separate Subroutine (single block of code):

Sub WriteValuesToWorksheet(worksheet, columnNumber, dim1Num1, dim1Num2, dim2Num1, dim2Num2, dim3Num1, dim3Num2, dim4Num1, dim4Num2, dim5)

    With worksheet
        .cells(9, columnNumber).Value = dim1Num1
        .cells(10, columnNumber).Value = dim1Num2
        .cells(11, columnNumber).Value = dim2Num1
        .cells(12, columnNumber).Value = dim2Num2
        .cells(13, columnNumber).Value = dim3Num1
        .cells(14, columnNumber).Value = dim3Num2
        .cells(15, columnNumber).Value = dim4Num1
        .cells(16, columnNumber).Value = dim4Num2
        .cells(17, columnNumber).Value = dim5
    End With
    
End Sub

You can then replace your If statement by first finding the column number from aperture using Mod. Once you have the column number, you can use the WriteValuesToWorksheet subroutine:

Dim columnNumber
columnNumber = 5 + (aperture Mod 6)
WriteValuesToWorksheet xlsWS, columnNumber, dim1Num1, dim1Num2, dim2Num1, dim2Num2, dim3Num1, dim3Num2, dim4Num1, dim4Num2, dim5num1

xlsWB.Save

This code will work with any number of apertures.

VB Script Simplification for "offset" repeating numbers?

1 Answers1