• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

This array is fixed or temporarily locked

M

mdavid

Member
Hi,
I have this vba code:

Code: 
Sub addImageURL()
    Dim Arr() As String
    Dim name As Variant
    Dim caption As String
    Dim totSpecies, totImages As Long
    Dim i, notFoundCnt, existCnt As Integer
    Dim speciesName As Variant
    notFoundCnt = 0
    existCnt = 0
    totSpecies = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    totImages = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To totSpecies
        imageName = Sheets(2).Cells(i, 2).Value
        Set found = Sheets(1).Range("E2:E" & totImages).Find(what:=imageName)
        If found Is Nothing Then
          GoTo nexti
       End If
       Sheets(2).Cells(i, 8).Value = found.Offset(, -2).Value
       Sheets(2).Cells(i, 9).Value = found.Offset(, -1).Value
       caption = "<a href=""https://florapalaestina-ethnobotany.org/?plant=" & Sheets(2).Cells(i, 1).Value
       caption = caption & "/"" target=""_blank"">" & vbCrLf & "<b>" & Sheets(2).Cells(i, 11).Value & "</b>" & vbCrLf
       If Len(Sheets(2).Cells(i, 4).Value) > 3 Then
           caption = caption & " <ul>"
            Arr = Split(Sheets(2).Cells(i, 4).Value, ",", 3)
            nameCnt = 0
            For Each name In Arr
               nameCnt = nameCnt + 1
               caption = caption & "<li>" & name & "</li>"
               If nameCnt > 2 Then
                  caption = caption & "</ul>" & vbCrLf
                  GoTo arb
               End If
           Next
           caption = caption & "</ul>" & vbCrLf
     End If
arb:
     If Len(Sheets(2).Cells(i, 6).Value) > 3 Then
            caption = caption & " <ul>"
            ReDim Arr(1 To 12) As String
            Arr = Split(Sheets(2).Cells(i, 6).Value, ",", 3)
            nameCnt = 0
            For Each name In Arr
               nameCnt = nameCnt + 1
               caption = caption & "<li>" & name & "</li>"
               If nameCnt > 2 Then
                  caption = caption & "</ul>" & vbCrLf
                  GoTo heb
               End If
           Next
           caption = caption & "</ul>" & vbCrLf
     End If
heb:
     If Len(Sheets(2).Cells(i, 5).Value) > 3 Then
           caption = caption & " <ul>"
            ReDim Arr(1 To 12) As String
            Arr = Split(Sheets(2).Cells(i, 5).Value, ",", 3)  'error 10 here
            nameCnt = 0
            For Each name In Arr             ' error occurs here on 2nd iteration
               nameCnt = nameCnt + 1
               caption = caption & "<li>" & name & "</li>"
               If nameCnt > 2 Then
                  caption = caption & "</ul>" & vbCrLf
                  GoTo endNames
               End If
           Next
           caption = caption & "</ul>" & vbCrLf
     End If

endNames:
    ReDim Arr(10)
    caption = caption & "</a>"
    Debug.Print "Caption" & caption
    Sheets(2).Cells(i, 10).Value = caption
nexti:
    Next i
End Sub
I know it's not very elegant - got my stripes in COBOL - but anyway the problem is around the 4th time I access the array I get the error:
"This array is fixed or temporarily locked". Googling I find it hard to understand the problem or the solution, so was thinking is there an alternative like ArrayList?
Appreciate any advice how I can get round this problem.
Thanks
 
Hi,​
​
it just seems a bad use of Goto statement - useless since more than 30 years ! - inside a loop …​
​
And obviously you can loop directly on the Split statement without any useless variable like Arr …​
​
 
Hi Marc,
Thanks for the advice - I'll get rid of the GoTo's.
Could you explain what you mean by
you can loop directly on the Split statement without any useless variable like Arr
Click to expand...
Thanks
 
In your For Each codeline just replace the variable Arr by the Split statement​
​
then maybe like this even with your Goto statement that may work …​
​
 
Try (also see comments):
Code: 
Sub addImageURL()
Dim Arr() As String
Dim name As Variant
Dim caption As String
Dim totSpecies, totImages As Long
Dim i, notFoundCnt, existCnt As Integer
Dim speciesName As Variant

notFoundCnt = 0
existCnt = 0
totSpecies = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
totImages = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To totSpecies
  imageName = Sheets(2).Cells(i, 2).Value
  Set found = Sheets(1).Range("E2:E" & totImages).Find(what:=imageName)
  If Not found Is Nothing Then
    Sheets(2).Cells(i, 8).Value = found.Offset(, -2).Value
    Sheets(2).Cells(i, 9).Value = found.Offset(, -1).Value
    caption = "<a href=""https://florapalaestina-ethnobotany.org/?plant=" & Sheets(2).Cells(i, 1).Value
    caption = caption & "/"" target=""_blank"">" & vbCrLf & "<b>" & Sheets(2).Cells(i, 11).Value & "</b>" & vbCrLf
    If Len(Sheets(2).Cells(i, 4).Value) > 3 Then
      caption = caption & " <ul>"
      Arr = Split(Sheets(2).Cells(i, 4).Value, ",", 3)
      nameCnt = 0
      For Each name In Arr
        'I don't think you need the commented-out klines below because you have limited the split to 3 anyway.
        'nameCnt = nameCnt + 1
        caption = caption & "<li>" & name & "</li>"
        '        If nameCnt > 2 Then
        '          caption = caption & "</ul>" & vbCrLf
        '          GoTo arb
        '        End If
      Next name
      caption = caption & "</ul>" & vbCrLf
    End If
    'arb:
    If Len(Sheets(2).Cells(i, 6).Value) > 3 Then
      caption = caption & " <ul>"
      'ReDim Arr(1 To 12) As String
      Arr = Split(Sheets(2).Cells(i, 6).Value, ",", 3)
      'nameCnt = 0
      For Each name In Arr
        'nameCnt = nameCnt + 1
        caption = caption & "<li>" & name & "</li>"
        '        If nameCnt > 2 Then
        '          caption = caption & "</ul>" & vbCrLf
        '          GoTo heb
        '        End If
      Next
      caption = caption & "</ul>" & vbCrLf
    End If
    'heb:
    If Len(Sheets(2).Cells(i, 5).Value) > 3 Then
      caption = caption & " <ul>"
      'ReDim Arr(1 To 12) As String
      Arr = Split(Sheets(2).Cells(i, 5).Value, ",", 3)    'error 10 here
      'nameCnt = 0
      For Each name In Arr    ' error occurs here on 2nd iteration
        'nameCnt = nameCnt + 1
        caption = caption & "<li>" & name & "</li>"
        '        If nameCnt > 2 Then
        '          caption = caption & "</ul>" & vbCrLf
        '          GoTo endNames
        '        End If
      Next
      caption = caption & "</ul>" & vbCrLf
    End If

endNames:
    'ReDim Arr(10)
    caption = caption & "</a>"
    Debug.Print "Caption" & caption
    Sheets(2).Cells(i, 10).Value = caption
  End If
Next i
End Sub

Now since you have 3 very similar chunks of code in the middle, you might be able to shorten it to:
Code: 
Sub addImageURL2()
Dim Arr() As String
Dim name As Variant
Dim caption As String
Dim totSpecies, totImages As Long
Dim i, notFoundCnt, existCnt As Integer
Dim speciesName As Variant

notFoundCnt = 0
existCnt = 0
totSpecies = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
totImages = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To totSpecies
  imageName = Sheets(2).Cells(i, 2).Value
  Set found = Sheets(1).Range("E2:E" & totImages).Find(what:=imageName)
  If Not found Is Nothing Then
    Sheets(2).Cells(i, 8).Value = found.Offset(, -2).Value
    Sheets(2).Cells(i, 9).Value = found.Offset(, -1).Value
    caption = "<a href=""https://florapalaestina-ethnobotany.org/?plant=" & Sheets(2).Cells(i, 1).Value
    caption = caption & "/"" target=""_blank"">" & vbCrLf & "<b>" & Sheets(2).Cells(i, 11).Value & "</b>" & vbCrLf

    For j = 1 To 3
      k = Application.Choose(j, 4, 6, 5)
      If Len(Sheets(2).Cells(i, k).Value) > 3 Then
        caption = caption & " <ul>"
        Arr = Split(Sheets(2).Cells(i, k).Value, ",", 3)
        nameCnt = 0
        For Each name In Arr
          caption = caption & "<li>" & name & "</li>"
        Next name
        caption = caption & "</ul>" & vbCrLf
      End If
    Next j

    caption = caption & "</a>"
    Debug.Print "Caption" & caption
    Sheets(2).Cells(i, 10).Value = caption
  End If
Next i
End Sub
 
Thanks very much for all your help - it's almost working, the one problem I'm having is with this (and all the other "Arr = Split(...")
Code: 
Arr = Split(Sheets(2).Cells(i, k).Value, ",", 3)
If there's more than 3 comma separated elements in the cell and the limit is 3 then it returns the first, second and then all the rest - with commas.
I want just the first 3 elements. How can I do that?
Thanks
 
try:
Code: 
Sub addImageURL2()
Dim Arr() As String, caption As String, totSpecies, totImages As Long
Dim imageName, found As Range
Dim i, j, k, m
'Dim notFoundCnt, existCnt As Long 'not used

'notFoundCnt = 0
'existCnt = 0
totSpecies = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
totImages = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To totSpecies
  imageName = Sheets(2).Cells(i, 2).Value
  Set found = Sheets(1).Range("E2:E" & totImages).Find(what:=imageName)
  If Not found Is Nothing Then
    Sheets(2).Cells(i, 8).Value = found.Offset(, -2).Value
    Sheets(2).Cells(i, 9).Value = found.Offset(, -1).Value
    caption = "<a href=""https://florapalaestina-ethnobotany.org/?plant=" & Sheets(2).Cells(i, 1).Value
    caption = caption & "/"" target=""_blank"">" & vbCrLf & "<b>" & Sheets(2).Cells(i, 11).Value & "</b>" & vbCrLf
    For j = 1 To 3
      k = Application.Choose(j, 4, 6, 5)
      If Len(Sheets(2).Cells(i, k).Value) > 3 Then
        caption = caption & " <ul>"
        Arr = Split(Sheets(2).Cells(i, k).Value, ",")
        For m = 0 To Application.Min(2, UBound(Arr))
          caption = caption & "<li>" & Arr(m) & "</li>"
        Next m
        caption = caption & "</ul>" & vbCrLf
      End If
    Next j

    caption = caption & "</a>"
    Debug.Print "Caption" & caption
    Sheets(2).Cells(i, 10).Value = caption
  End If
Next i
End Sub
 
Last edited:
Hi p45cal, Thanks very much for taking the time to sort this out for me.
Never used
Code: 
Application.Min or Application.Choose
before, don't really understand them but I used your code and it works.
Thanks, much appreciated
 
You must log in or register to reply here.
Back
Top