Infinite Loop

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,913
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have a column of data in column A. All I want to do is add zeros if the length is less than 5, eg 1 becomes 00001.

This code gets stuck in an infinite loop:

Code:
Public Sub UsingArray()
     
    Dim OrigVals As Variant
 
    OrigVals = Sheet1.Cells(1, 1).CurrentRegion.Value
 
    Dim a As Class1
    Set a = New Class1
 
    With a
     
        Set .ws = Sheet1
     
        .DataArray = OrigVals
     
        Call .CreateList

    End With
 
End Sub

This is Class1:

Code:
Private pDataArray As Variant
 
    Private pws As Worksheet

Public Property Get DataArray() As Variant

    DataArray = pDataArray
 
End Property

Public Property Let DataArray(ByVal DArray As Variant)

    pDataArray = DArray
 
End Property

Public Property Get ws() As Worksheet

    Set ws = pws
 
End Property

Public Property Set ws(ByVal w As Worksheet)

    Set pws = w
 
End Property

Public Sub CreateList()
    
    Dim DataArrayRows As Long
 
    DataArrayRows = UBound(Me.DataArray, 1)
 
    Dim Counter As Long
 
    For Counter = 1 To DataArrayRows
 
        If Len(Me.DataArray(Counter, 1)) < 5 Then
     
            Do Until Len(Me.DataArray(Counter, 1)) = 5
         
                Me.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)
         
            Loop
     
        End If
    
    Next Counter
 
    Me.ws.Cells(1, 3).Resize(DataArrayRows, 1).Value = Me.DataArray
 
End Sub

I have discovered I have to change this line from:

Code:
    Me.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

to:

Code:
    pDataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

to make it work.


However, the following code (using strings) does work:

Code:
Public Sub UsingString()

    Dim Val As String
 
    Val = Sheet1.Cells(1, 1).Value

    Dim b As Class2
    Set b = New Class2
 
    With b
 
        Set .ws = Sheet1
     
        .Val = Val
     
        Call .CreateList
 
    End With
 
End Sub

Class2:

Code:
    Private pVal As String
    Private pws As Worksheet

Public Property Get Val() As String

    Val = pVal
 
End Property

Public Property Let Val(ByVal V As String)

    pVal = V
 
End Property

Public Property Get ws() As Worksheet

    Set ws = pws
 
End Property

Public Property Set ws(ByVal w As Worksheet)

    Set pws = w
 
End Property

Public Sub CreateList()

    If Len(Me.Val) < 5 Then
     
        Do Until Len(Me.Val) = 5
     
            Me.Val = "0" & Me.Val
     
        Loop
 
    End If
    
    Me.ws.Cells(1, 5).Value = Me.Val
 
End Sub

Can someone pleae explain why I needed to change:

Code:
Me.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

to

Code:
p.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

to make it work using arrays but I didn't have to change anything if I use string?

Thanks
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
You will notice that this line:

VBA Code:
               Me.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

does not call your Property Let routine. It calls the Property Get twice, which should tell you that your code is working with copies of the array. Your property Let only allows for assigning the entire array, not individual items.
 
Upvote 0
You will notice that this line:

VBA Code:
               Me.DataArray(Counter, 1) = "0" & Me.DataArray(Counter, 1)

does not call your Property Let routine. It calls the Property Get twice, which should tell you that your code is working with copies of the array. Your property Let only allows for assigning the entire array, not individual items.
Thanks for the explantion.

So how would you assign individual items? Change it to pDataArray(Counter, 1) as I have suggested or should something else be done?
 
Upvote 0
Since it's a purely internal process, you might as well just use the variable directly as you have, unless there might be any time you want external code to be able to set a specific value (without having to extract the entire array, manipulate it, then put it back).
 
Upvote 0
Thanks.

I tried adding something like this:

Code:
Property Get DataArrayItem(RowIndex, ColIndex) As Variant

    DataArrayItem = DataArray(RowIndex, ColIndex)
    
End Property

but got into a right mess!
 
Upvote 0
Not much I can say to that. ;)
 
Upvote 0
Not much I can say to that. ;)
I think I got it to work using this:

Code:
Public Sub UsingArray()
 
    Dim a As Class1
    Set a = New Class1
 
    Set a.ws = Sheet1
 
    Dim i As Long
 
    For i = 1 To 5
 
        a.DataArrayItem(i, 1) = Sheet1.Cells(i, 1).Value
     
    Next i
 
    Call a.CreateList

End Sub

Class1:

Code:
    Private pDataArrayItem() As Variant
    Private pws As Worksheet

Private Sub Class_Initialize()

    ReDim pDataArrayItem(1 To 5, 1 To 1) As Variant

End Sub

Property Get DataArrayItem(ByVal RowIndex As Variant, ByVal ColIndex As Variant) As Variant

    DataArrayItem = pDataArrayItem(RowIndex, ColIndex)

End Property

Public Property Let DataArrayItem(ByVal RowIndex As Variant, ByVal ColIndex As Variant, MArray As Variant)

    pDataArrayItem(RowIndex, ColIndex) = MArray
 
End Property


Public Property Get ws() As Worksheet

    Set ws = pws
 
End Property

Public Property Set ws(ByVal w As Worksheet)

    Set pws = w
 
End Property

Public Sub CreateList()
 
    Dim Counter As Long

    For Counter = 1 To 5

        If Len(Me.DataArrayItem(Counter, 1)) < 5 Then

            Do Until Len(Me.DataArrayItem(Counter, 1)) = 5

                Me.DataArrayItem(Counter, 1) = "0" & Me.DataArrayItem(Counter, 1)

            Loop

        End If

    Next Counter

    For Counter = 1 To 5
 
        Me.ws.Cells(Counter, 5).Value = Me.DataArrayItem(Counter, 1)
 
    Next Counter
 
End Sub

Note this line:

Code:
 Me.DataArrayItem(Counter, 1) = "0" & Me.DataArrayItem(Counter, 1)

DOESN'T use p (as I wanted all along).

but it seems I have to loop to return the values to the worksheet, as opposed to using Resize.

So is this an alternative to my original solution?
 
Upvote 0
It's an alternative, certainly. I don't see why it would be preferable though. All you really needed was to add properties to the original to read/write specific array elements, not remove the ability to read/write the array in one go.
 
Upvote 0
It's an alternative, certainly. I don't see why it would be preferable though. All you really needed was to add properties to the original to read/write specific array elements, not remove the ability to read/write the array in one go.
"All you really needed was to add properties to the original to read/write specific array elements, not remove the ability to read/write the array in one go."

Can you show me how that's done?
 
Upvote 0
For example:

VBA Code:
Option Explicit

Private pDataArray As Variant
 
    Private pws As Worksheet

Public Property Get DataArray() As Variant

    DataArray = pDataArray
 
End Property

Public Property Let DataArray(ByVal DArray As Variant)

    pDataArray = DArray
 
End Property
Property Get DataArrayItem(ByVal RowIndex As Variant, ByVal ColIndex As Variant) As Variant

    DataArrayItem = pDataArray(RowIndex, ColIndex)

End Property

Public Property Let DataArrayItem(ByVal RowIndex As Variant, ByVal ColIndex As Variant, MArray As Variant)

    pDataArray(RowIndex, ColIndex) = MArray
   
End Property
Public Property Get ws() As Worksheet

    Set ws = pws
 
End Property

Public Property Set ws(ByVal w As Worksheet)

    Set pws = w
 
End Property

Public Sub CreateList()
    
    Dim DataArrayRows As Long
 
    DataArrayRows = UBound(Me.DataArray, 1)
 
    Dim Counter As Long
 
    For Counter = 1 To DataArrayRows
 
        If Len(Me.DataArrayItem(Counter, 1)) < 5 Then
     
            Do Until Len(Me.DataArrayItem(Counter, 1)) = 5
         
                Me.DataArrayItem(Counter, 1) = "0" & Me.DataArrayItem(Counter, 1)
         
            Loop
     
        End If
    
    Next Counter
 
    Me.ws.Cells(1, 3).Resize(DataArrayRows, 1).Value = Me.DataArray
 
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top