0

I'm trying to make an automated templated with VBA and this code seems to run fine when I enter in a low number of "pages", but when I enter in something such as the following into the prompts it gives me a run-time error 1004: 14 pages: 41, 26, 19, 28, 26, 28, 17, 26, 21, 19, 19, 10, 23, 28.

Public TitleSize As Integer
Public MostValves() As Integer
Public TotalValves As Integer
Public TitleBlockSize As Integer

Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

Sub ManualValve()

'On Error GoTo ErrHandler
'On Error Resume Next

Worksheets(1).Activate
ActiveSheet.Name = "Valve List"
ActiveSheet.Cells.Clear

PnIDPage = InputBox("How many pages are on your P&ID?")
'Values for Number of Pages: 14

Dim i As Integer

TotalValves = 0

ReDim MostValves(PnIDPage)

For i = 0 To PnIDPage - 1

    ValveCount = InputBox("How many valves are on page " & i + 1 & " ?")
'Values for valves: 41, 26, 19, 28, 26, 28, 17, 26, 21, 19, 19, 10, 23, 28
    If IsNumeric(ValveCount) Then
        MostValves(i) = ValveCount
        TotalValves = TotalValves + ValveCount
    Else
        MsgBox ("You did not enter a valid number")
        'GoTo ErrHandler
    End If
Next i

Dim Title As Variant

Response = MsgBox(prompt:="Do you want to use the default titleblock? (Count, Valve, Module, Note)", Buttons:=vbYesNo)

If Response = vbYes Then
    Title = Array("Count", "Valve", "Module", "Note")
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1
Else
    Title = Array("Count", "Valve", "Module")
    TitleSize1 = UBound(Title, 1) - LBound(Title, 1) + 1
    XtraCol = InputBox("How many extra columns would you like to add?")
    ReDim Preserve Title(XtraCol + TitleSize1 - 1)
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1
        For i = TitleSize1 + 1 To TitleSize
            XtraTitle = InputBox("Extra Title " & i & "?")
            Title(i - 1) = XtraTitle
        Next i
End If

Dim TitleBlock As Variant

TitleBlock = Array("Project Number", "Project Name", "By", "Rev", "Date")
TitleBlockSize = UBound(TitleBlock, 1) - LBound(TitleBlock, 1) + 1
Range(ConvertToLetter(1) & "1:" & ConvertToLetter(1) & TitleBlockSize) = Application.Transpose(TitleBlock)

Dim Maximum As Integer
Dim ValveNum() As Integer
Dim TempSize As Integer

TempSize = 1
Maximum = WorksheetFunction.Max(MostValves) + 1

For i = 0 To PnIDPage - 1
    Do Until MostValves(i) <> 0
        i = i + 1
    Loop

    ReDim ValveNum(MostValves(i))

    For j = 0 To MostValves(i)
        ValveNum(j) = j + 1
    Next j
        MsgBox TempSize
        If i Mod 2 = 0 Then
            Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 42
        Else
'This is where I encounter the run-time error
            Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 43
        End If

        Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize) & CStr(MostValves(i) + 1 + TitleBlockSize)). _
        Resize(MostValves(i), 1) = Application.Transpose(ValveNum)
        Worksheets(1).Range(ConvertToLetter(TempSize + 2) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + 2) & CStr(MostValves(i) + 1 + TitleBlockSize)) = "00" & CStr(i + 1)
        Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & TitleBlockSize + 1) = Title
        TempSize = TempSize + TitleSize
        Worksheets(1).Range(ConvertToLetter(TempSize - 1) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _
        Borders(xlEdgeRight).Weight = xlMedium
    Next i

    Cells(1, 4) = "Total Valve Count"
    Cells(1, 5) = TotalValves
    Range("A1:" & ConvertToLetter(TempSize) & Maximum + TitleBlockSize).HorizontalAlignment = xlCenter
    Range("A1:A" & TitleBlockSize).HorizontalAlignment = xlLeft
    Columns("A:" & ConvertToLetter(TempSize)).AutoFit
    Range("A1:" & ConvertToLetter(TempSize) & TitleBlockSize + 1).Font.Bold = True
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Interior.ColorIndex = 1
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Font.Color = vbWhite
    Range("A" & Maximum + TitleBlockSize & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _
        Borders(xlEdgeBottom).Weight = xlMedium

'ErrHandler:
    'MsgBox "An error has occurred. The macro will end."

End Sub
Mirage24
  • 45
  • 3
  • It would be great to know _on which line_ the error is raised. – Matteo NNZ Jan 07 '15 at 22:41
  • It varies on the line depending on how many inputs I put in, but it is always within the for loop that says: "For i = 0 To PnIDPage - 1" and seems to fail when I call the Range object over and over again – Mirage24 Jan 07 '15 at 22:44
  • Please use one of these values and copy here both the value you input and the precise line where the error raises. – Matteo NNZ Jan 07 '15 at 22:53
  • If I follow the prompts and enter in: 14 pages, then 41, 26, 19, 28, 26, 28, 17, 26, 21, 19, 19, 10, 23, 28 as quantities for the valves, then click yes for use default title. I get an error hereWorksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 43 – Mirage24 Jan 07 '15 at 23:03
  • Sorry but we still miss something. What is the input variable (where you insert 14)? Could you please edit your question's body and add all this information (the one of your previous comment + this one), and reduce the code size to a minimized sample on which we can see directly the problem? – Matteo NNZ Jan 07 '15 at 23:11
  • I added in comments in the code to see which values to put into the inputs. If you copy and paste that into a module you should see the error. – Mirage24 Jan 07 '15 at 23:18
  • Can you reduce your code to the *minimum necessary to reproduce the problem*? There's a lot of clutter here that could be removed, it would seem, and during the process of doing so you may find a cause. There's simply too much to expect us to wade through here. See [How to create a Minimal, Complete, and Verifiable example](http://stackoverflow.com/help/mcve) for tips on doing so. – Ken White Jan 07 '15 at 23:28

1 Answers1

1

The problem does not depend on your Valve, but on your ConvertToLetter function. In fact, at some point the error occurs because the function returns an invalid range letter:

input: iCol = 53
return: "A["

Clearly, when you try to call the Range("A[2"), this raises the exception.

The code inside your function is not solid because converts the number into letter with:

ConvertToLetter = Chr(iAlpha + 64)

The Chr() function returns the value associated to the index from the characters collection, which is a unique chars list and cannot be used as you try to do there. I would just replace your ConvertToLetter function with a more solid one, such as the following:

Function ConvertToLetter(iCol As Integer) As String
    Dim vArr
    vArr = Split(Cells(1, iCol).Address(True, False), "$")
    ConvertToLetter = vArr(0)
End Function

...which has been kindly provided by brettdj in one of his precious answers (don't forget to give him an upvote for this piece of gold ;).

P.s. note that this explain also why a low number would not raise the exception: as long as the number is small, your function doesn't need to append a second letter to the output so it remains consistent. But as soon as it has to do that, CRASH ;)

Use the above function, it's way safer because it just retrieves the Range address from the Cells object. Your code will work fine once you will replace your old function with the new one above.

Community
  • 1
  • 1
Matteo NNZ
  • 11,930
  • 12
  • 52
  • 89