2 dimensional array is causing run-time error 91

vba317 · Oct 22, 2015

I am writing code to change the read the formatting of the cells in my worksheets. I got the code working using for loops but it takes too long running this way. So I am trying to rewrite the code using arrays . On the worksheet I am on now I have two tables that I have to loop through. Table 1 - B2:H14 Table 2 - AB2:AH14

Right now I am trying to get the first loop working. Currently the loop starts in cell B2 and stops at G2 then goes to H3 and gives me the run-time error 91.

Any help is appreciated

Tom

Code:

Public Sub ChangeDecimalPlaces1()
Dim wrkbk As Excel.Workbook
Dim wrkSh As Excel.Worksheet
Dim intRound As Double
Dim intRound1 As Double
Dim intRound2 As Double
Dim dblDecPlaces As Double
Dim strType As String
Dim rngRound As Range
Dim strRange As String
Dim strFormat As String
Dim lngLastR As Long, lngCnt As Long
Dim varSrc As Variant, varComp As Variant, x
Dim rng1 As Range, rng2 As Range
Dim lngShCnt As Long
Dim lngShCntTot As Long
Dim strOutputData As String
Dim wrkShSrc As Excel.Worksheet
Dim wrkShComp As Excel.Worksheet
Dim wrkShOutput As Excel.Worksheet
Dim rngSrc As Range
Dim rngComp As Range
'Last Row Number for source table
Dim lngLastRowSrc As Long
'Last Column Number for source table
Dim lngLastColDataSrc As Long
'Last Column Number for compare table
Dim lngLastColDataComp As Long
'First column number for comparison table
Dim lngFirstColDataComp As Long
'Start Column for compare table
Dim lngStartColComp As Long
'First Column of compare table
Dim strFirstColComp As String
Dim strDataSrc As String
Dim lngFirstEmptyCol As Long
Dim strFirstEmptyCol As String
Dim strDataComp As String
Dim lngLastRowComp As Long
Dim lngLastRowOutput As Long
Dim lngRowSrc As Long
Dim lngColSrc As Long
Dim strSheet As String
Dim lngErrCnt As Long
Dim lngColComp As Long
Dim lngWksCnt As Long
Dim strHeader(10) As String
Dim lngLoop As Long
Dim col As Long
Dim C As Excel.Range
Dim R As Excel.Range
Dim lngColCnt As Long
Dim lngRowCnt As Long
Dim lngColumns As Long
Dim lngRows As Long
Dim lngHeader As Long
Dim lngStartColumnSrc As Long


Set wrkbk = ActiveWorkbook
Application.ScreenUpdating = False




'Loop based on headers


'header = "this one" ' header name to find
strHeader(1) = "BI"
strHeader(2) = "PD"
strHeader(3) = "MP"
strHeader(4) = "Comp"
strHeader(5) = "Coll"
strHeader(6) = "UM"
strHeader(7) = "Fixed"
strHeader(8) = "Sort"
lngShCntTot = wrkbk.Sheets.Count
For lngShCnt = 6 To lngShCntTot
    Set wrkShSrc = Worksheets(lngShCnt)
    Set wrkShComp = Worksheets(lngShCnt)
     Worksheets(lngShCnt).Activate
     
'  If ActiveSheet.Name = "Longevity_Mapping_018" Then Call TexttoCol
  
  'Skip Sheets that don't have numbers to convert
  
  Select Case ActiveSheet.Name
    Case "Longevity_001"
         strHeader(1) = "Factor"
    Case "Longevity_002"
         strHeader(1) = "Factor"
    Case "Longevity_003"
         GoTo 1
    Case "Longevity_006"
         strHeader(1) = "Factor"
    Case "Longevity_007"
         strHeader(1) = "Factor"
    Case "Longevity_009"
         strHeader(1) = "Factor"
    Case "Longevity_010"
         strHeader(1) = "Factor"
    Case "Longevity_011"
         strHeader(1) = "Factor"
    Case "Longevity_012"
         strHeader(1) = "Factor"
    Case "Longevity_013"
         strHeader(1) = "Factor"
    Case "Longevity_014"
         strHeader(1) = "Factor"
    Case "Longevity_015"
         strHeader(1) = "Factor"
    Case "Longevity_016"
         strHeader(1) = "Factor"
    Case "Longevity_017"
         strHeader(1) = "Factor"
    Case "Longevity_018"
        GoTo 1
    Case "Longevity_Mapping_018"
        GoTo 1
    Case "Longevity_019"
         strHeader(1) = "Factor"
    Case "Policy_Mapping_001"
        GoTo 1
    Case "Tier_Mapping_045"
        GoTo 1
    Case "Tier_Caps_056"
        GoTo 1
    Case "Misc_001"
        GoTo 1
    Case "Misc_002"
        GoTo 1
    Case "Misc_003"
        GoTo 1
    Case "Misc_004"
        GoTo 1
    Case "Misc_005"
        GoTo 1
    Case "Misc_006"
        GoTo 1
    Case "Misc_007"
        GoTo 1
    Case "Misc_008"
        GoTo 1
    Case "Misc_009"
        strHeader(1) = "Comp"
        strHeader(2) = "Coll"
        strHeader(3) = "Sort"
    Case "Misc_010"
        strHeader(1) = "Comp"
        strHeader(2) = "Coll"
        strHeader(3) = "Sort"
    Case "Misc_011"
        strHeader(4) = "Sort"
    Case "Misc_014"
        strHeader(1) = "Comp"
        strHeader(2) = "Coll"
        strHeader(3) = "Sort"
    Case "Misc_015"
        strHeader(1) = "Comp"
        strHeader(2) = "Coll"
    Case "Misc_016"
        strHeader(1) = "Comp"
        strHeader(2) = "Sort"
   End Select
     Debug.Print ActiveSheet.Name
     Stop
    Application.ScreenUpdating = False
    'Determine Last Row and last Column of Current Worksheet
    lngLastRowSrc = wrkShSrc.Range("A" & Rows.Count).End(xlUp).Row
    lngLastColDataSrc = wrkShSrc.Range("Z1").End(xlToLeft).Column
    strDataSrc = ColLtr(lngLastColDataSrc)
    lngFirstEmptyCol = lngLastColDataSrc + 1
    strFirstEmptyCol = ColLtr(lngFirstEmptyCol)
    'Determine Last Row and Column of Comparison Range on same worksheet
    lngLastColDataComp = wrkShComp.Range("AZ1").End(xlToLeft).Column
    strDataComp = ColLtr(lngLastColDataComp)
    lngFirstColDataComp = wrkShSrc.Range("Z1").End(xlToRight).Column + 1
    strFirstColComp = ColLtr(lngFirstColDataComp)
    lngLastRowComp = wrkShSrc.Range("AA" & Rows.Count).End(xlUp).Row


    lngRowCnt = 0
    lngColumns = 0
    lngHeader = 0
    ' Stop
            If wrkShSrc.Range("B1").Value = "BI" Then lngStartColumnSrc = 2
            If wrkShSrc.Range("B1").Value = "Factor" Then lngStartColumnSrc = 2
            If wrkShSrc.Range("B1").Value = "Comp" Then lngStartColumnSrc = 2
            If wrkShSrc.Range("C1").Value = "BI" Then lngStartColumnSrc = 3
            If wrkShSrc.Range("D1").Value = "BI" Then lngStartColumnSrc = 4
            If wrkShSrc.Range("D1").Value = "Factor" Then lngStartColumnSrc = 4
            If wrkShSrc.Range("E1").Value = "BI" Then lngStartColumnSrc = 5
     'Loop through Source Columns of table
     Dim Arr() As Variant


    Stop
'    Arr = Range("B" & lngStartColumnSrc & ":" & strDataSrc & lngLastRowSrc)
    Arr = Range("B2:H14")
    
        For lngRowCnt = LBound(Arr, 1) To UBound(Arr, 1) ' First array dimension is rows
            For lngColCnt = LBound(Arr, 2) To UBound(Arr, 2) ' Second array dimension is columns
                Debug.Print Arr(lngRowCnt, lngColCnt)
                lngHeader = 1 + lngHeader
                'Finds column header
                Set C = wrkShSrc.Range("B1:" & strDataSrc & "1").Find(strHeader(lngHeader), LookIn:=xlValues)
                
'                lngRowCnt = lngRows
   [Blue]             lngColCnt = C.Column  [/Blue]
                If lngRowCnt = 1 Then lngRowCnt = lngRowCnt + 1
                Set rngRound = wrkShSrc.cells(lngRowCnt, lngColCnt)
'                lngColCnt =
'                Set c = ActiveSheet.Range("B1:" & strDataSrc & lngLastRowSrc).Find(strHeader(lngColumns), LookIn:=xlValues)
                    If Not C Is Nothing Then
                        If rngRound = 0 Then
                            strFormat = "0"
                            With wrkShSrc.cells(lngRowCnt, lngColCnt)
                                'Formats cell to amount of places that is needed
                                .NumberFormat = strFormat
                                .IndentLevel = 1
'                               .Value = Format(intRound, strFormat)
                            End With
                        End If
                       If rngRound <> 0 Then
                         With wrkShSrc.cells(lngRowCnt, lngColCnt)
                                'Formats cell to amount of places that is needed
'                                .NumberFormat = strFormat
'                                .IndentLevel = 1
''                               .Value = Format(intRound, strFormat)
                           
                                intRound = (rngRound)
'                                intRound = wrkSh.Range(rngRound).Value
                                'Get number of decimal places
                                dblDecPlaces = DigitCount(intRound)
                                dblDecPlaces = dblDecPlaces - 1
                                Call SetDecimalPlaces(dblDecPlaces, strFormat)
                                .NumberFormat = strFormat
                                .IndentLevel = 1
                           End With
                    
                    End If
 
                End If 'Not c Is Nothing Then


            Next lngColCnt
        Next lngRowCnt
    lngHeader = 0
'Loop through Compare table
If wrkShSrc.Range("AB1").Value = "BI" Then lngStartColComp = 27
If wrkShSrc.Range("AB1").Value = "Factor" Then lngStartColComp = 27
If wrkShSrc.Range("AB1").Value = "Comp" Then lngStartColComp = 27
If wrkShSrc.Range("AC1").Value = "BI" Then lngStartColComp = 28
If wrkShSrc.Range("AD1").Value = "BI" Then lngStartColComp = 29
If wrkShSrc.Range("AE1").Value = "BI" Then lngStartColComp = 30
           


    'Loop through Compare Columns of table
    For lngColumns = lngStartColComp To lngLastColDataComp
    lngHeader = lngHeader + 1
'     Stop
'        End If 'Not c Is Nothing Then
            'Loop through rows
            Debug.Print ActiveSheet.Name
            For lngRows = 2 To lngLastRowComp
                'Does not change rows


                'Finds column header
                Set C = wrkShComp.Range(strFirstColComp & "1:" & strDataComp & "1").Find(strHeader(lngHeader), LookIn:=xlValues)
          
                lngRowCnt = lngRows


'            lngRows = c.Row
            lngRowCnt = lngRows
            lngColCnt = C.Column
            Set rngRound = wrkShComp.cells(lngRowCnt, lngColCnt)
            strType = CellType(rngRound)
                If strType <> "Number" Then
                    Else
                    'If Cell is a number
                    If rngRound = 0 Then
                        strFormat = "0"
                        With wrkShComp.cells(lngRowCnt, lngColCnt)
                            'Formats cell to amount of places that is needed
                            .NumberFormat = strFormat
                            .IndentLevel = 1


                        End With
                            Else
                            
                            With wrkShComp.cells(lngRowCnt, lngColCnt)
                               
                                intRound = (rngRound)
                                'Get number of decimal places
                                dblDecPlaces = DigitCount(intRound)
                                dblDecPlaces = dblDecPlaces - 1
                                Call SetDecimalPlaces(dblDecPlaces, strFormat)
                                .NumberFormat = strFormat
                                .IndentLevel = 1
                           End With
                        End If 'rngRound = 0
                    End If 'strType <> "Number"
                End If 'Not c Is Nothing Then
            Next lngRows
    Next lngColumns
    
1:
  
Next lngShCnt


Application.ScreenUpdating = True
End Sub

StephenCrump · Oct 22, 2015

I'm guessing that [Blue] indicates where the error arises? Which presumably occurs because C is Nothing, i.e. the Find wasn't successful?

Code:

Set C = wrkShSrc.Range("B1:" & strDataSrc & "1").Find(strHeader(lngHeader), LookIn:=xlValues)
                
'                lngRowCnt = lngRows
   [Blue]             lngColCnt = C.Column  [/Blue]

Do you care to back up a bit and tell us what you're trying to do, as I'm sure your code can be written far more succinctly.

vba317 · Oct 22, 2015

Your right the blue is where the error is and c has nothing. To clarify, what I have to do is look at all the worksheets in my workbook (181 of them). On each sheet look at the columns that have numbers in them and eliminate all the trailing zeros on every number. From researching the sheets I found that most of the sheets have the headings of strHeader(1) = "BI", strHeader(2) = "PD",strHeader(3) = "MP",strHeader(4) = "Comp",strHeader(5) = "Coll,strHeader(6) = "UM",strHeader(7) = "Fixed". since some sheets start with BI as the second column, some sheets have BI as the third column and some as the fourth column. This is why I used the Set C = wrkShSrc.Range("B1:" & strDataSrc & "1").Find(strHeader(lngHeader), LookIn:=xlValues) this does look for the column heading correctly. I used the case statements because some sheets don't have any numbers to look at.

Tom

vba317 · Oct 22, 2015

Also I have two tables on each sheet the first table typically goes from Columns A - H. The second table starts on column AA and goes to AH.

StephenCrump · Oct 22, 2015

vba317 said:
On each sheet look at the columns that have numbers in them and eliminate all the trailing zeros on every number.

Are these text strings that you want to convert to numbers? For example, convert:

Excel 2010

	A
1	00001
2	00002
3	0001.2
4	SomeTextValue
5	0003.456

Sheet1

to:

Excel 2010

	A
1	1
2	2
3	1.2
4	SomeTextValue
5	3.456

Sheet1

If so, all you need here is:

Code:

Set rng = Sheets("Sheet1").Range("A1:A5")
rng.Value = rng.Value

... and rng will vary from sheet to sheet?

vba317 · Oct 22, 2015

StephenCrump said:
Are these text strings that you want to convert to numbers? For example, convert:

Excel 2010

A
1 00001
2 00002
3 0001.2
4 SomeTextValue
5 0003.456

<tbody>
</tbody>
Sheet1
to:

Excel 2010

A
1 1
2 2
3 1.2
4 SomeTextValue
5 3.456

<tbody>
</tbody>
Sheet1
If so, all you need here is:

Code:

Set rng = Sheets("Sheet1").Range("A1:A5") rng.Value = rng.Value

... and rng will vary from sheet to sheet?

No, the issue is the formatting needs to be changed.
For example a number is 1.000000 and should be 1, also 1.0034500 should be 1.00345

vba317 · Oct 22, 2015

No, the issue is the formatting needs to be changed.
For example a number is 1.000000 and should be 1, also 1.0034500 should be 1.00345.

The range of columns and rows that is being checked does change on different sheets.
Some sheets have 20 rows, some sheets have 20,000 rows. Some sheets have three columns and some have 12 columns to check.

StephenCrump · Oct 22, 2015

Sorry, you clearly said "trailing zeros" and for some reason I misinterpreted as "leading zeros".

Won't a simple:

.NumberFormat = "General"

applied to the entire range, sheet by sheet, give you the formatting you want?

2 dimensional array is causing run-time error 91

vba317

Board Regular

Excel Facts

StephenCrump

MrExcel MVP

vba317

Board Regular

vba317

Board Regular

StephenCrump

MrExcel MVP

vba317

Board Regular

vba317

Board Regular

StephenCrump

MrExcel MVP

Similar threads

Forum statistics

Share this page

2 dimensional array is causing run-time error 91

Board Regular

Excel Facts

MrExcel MVP

Board Regular

Board Regular

MrExcel MVP

Board Regular

Board Regular

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock