Redim Preserve?

[silentwolf]

Hi guys,

I am struggling again gg../

Function MandatLoeschen(ByVal strText As String) As String
    Dim strSearch As String
    Dim varWoerter As Variant
    Dim lngCounter As Long

    
    Dim strMandat As String
    
    strSearch = "Mandatsnummer:"
    
    varWoerter = Split(strText, " ")
    
    For lngCounter = LBound(varWoerter) To UBound(varWoerter)
        If varWoerter(lngCounter) = strSearch Then
            MandatLoeschen = varWoerter(lngCounter) & " " & varWoerter(lngCounter + 1)
            
            
            MandatLoeschen = Replace(strText, MandatLoeschen, "")
            
        Else
     End If
    Next lngCounter
End Function

Following code works if I am not using it within my code..
When I run it from another code it delets the remaining records ..(
So I guess there need to be a redim preserve in it .. but in my case how does this one need to be??

Many thanks as always

 

[silentwolf]

Hi guys,

I am just not sure how to set this up properly..

    Mandat = Range("J2", Range("J1").End(xlDown))
    
    For i = LBound(Mandat, 1) To UBound(Mandat, 1)
        Mandat(i, 1) = MandatLoeschen(Mandat(i, 1))
    Next i
    Range("J2").Resize(UBound(Umsatztext, 1), 1) = Mandat

This is the other array how I like to run this above code so do I need to redim it on this code??

Many thanks for your help!! I am still a little struggling with arrays I am affraid

 

[Norie]

What exactly is being deleted?

That function won't change anything unless you are assigning the value returned by the function to something else.

 

[silentwolf]

Hi Norie,

Thanks for your input!!
It deletes all other cells in the column(J) which are not getting updatet.. So all cells where the array finds cells are remaining but all others which have no "mandatnummer" are getting deleted
So there must be the issure with the second code I have posted and there I guess need to be a redim preserve statement or am I wrong???

 

[Norie]

Don't think it's anything to do with ReDim/Redim Preserve.

What is the function mean to do?

 

[silentwolf]

Ok I try to explain it ,,,

The function split the string into seperate parts so varWoerter ... if the value in that cell is found then it replaces the value with an empty string..

So in the cell ist a text like " Mr Huber mandatsnummer: 121213 and some other text in that cell"
The function looks for "mandatsnummer" if it found it in that cell then it returns "mandatsnummer: 121213" as it looks for the mandtnumber and the value in the next varWoerter... which is 121213.
once it got it then it replaces the new found string "mandatnumber. 121213" with an empty string.. New text = "Mr Huber and some other text in that cell"

The second code runs through the column(J) and looks for all values puts it into Mandat()array and runs the function ...returns the updatet values into column(J) ... that part works ...
But all remaining cells where there was no "Mandatnumber" is gone.. So I gues it need to be redim preseve on my second Code.. So it keeps the old values

But I am not sure where to put it and I tried many different things put get an runtime error out of range..

can you just point me to the right direction??

    ReDim Preserve Mandat(UBound(Mandat) + 1)
    
    Mandat = Range("J2", Range("J1").End(xlDown))

    
    For i = LBound(Mandat, 1) To UBound(Mandat, 1)

    
        Mandat(i, 1) = MandatLoeschen(Mandat(i, 1))
    Next i
    Range("J2").Resize(UBound(Umsatztext, 1), 1) = Mandat

this is what I tried.. not working.. runtime error.

How is the correct statement for the redim? If you tell me than it might work .)

 

[silentwolf]

Maybe this would help more..

Sub TestWith_Array()
    Dim Mandat() As Variant
    Dim i As Integer
    
    Mandat = Range("J2", Range("J1").End(xlDown))
    For i = LBound(Mandat, 1) To UBound(Mandat, 1)
        Mandat(i, 1) = MandatLoeschen(Mandat(i, 1))
    Next i
    Range("J2").Resize(UBound(Mandat, 1), 1) = Mandat

End Sub

Sorry about not sending it befor!! It was in a larger code .. and I thought it is easy to understand but I guess this is now alot better..

Many thanks guys!!!

 

[Norie]

You don't need to redim preserve anything, you need to change your function(s) so that if nothing is found they return the original text.

Or change the code so that the function(s) aren't called unless they are actually needed.

Not 100% sure how you would do either as I've not seen any data.

 

[silentwolf]

Oh really?

I can not send some data sorry that would be way to long for this area..)
"Some Data with Mandatsnummer: 121222121254513212 REF: 1121545454241
"No Number in this one"
"Again some Mandatsnummer: 111111555255 in some other Place where the gras is always green"
"My new home data Mandatsnummer: 1234567544 this is a nice place too"
"No need for a Mandatsnummer: 123666955 or is there one?"

This is something how it would be ... but I can not make it to work unfortunately .( crying gg

 

[shg]

How about a UDF?

Function SW(sInp As String, ByVal sFind As String) As String
  Dim asWd()        As String
  Dim i             As Long

  sFind = LCase(sFind)

  asWd = Split(sInp & " ")
  For i = 0 To UBound(asWd)
    If LCase(asWd(i)) = sFind Then
      SW = asWd(i) & " " & asWd(i + 1)
      Exit For
    End If
  Next i
End Function

	A​	B​	C​
1​	​	​	​
2​	"Some Data with Mandatsnummer: 121222121254513212 REF: 1121545454241	Mandatsnummer: 121222121254513212	B2: =SW(A2, "Mandatsnummer:")
3​	"No Number in this one"
4​	"Again some Mandatsnummer: 111111555255 in some other Place where the gras is always green"	Mandatsnummer: 111111555255
5​	"My new home data Mandatsnummer: 1234567544 this is a nice place too"	Mandatsnummer: 1234567544
6​	"No need for a Mandatsnummer: 123666955 or is there one?"	Mandatsnummer: 123666955
7​	Blah blah blah Mandatsnummer:	Mandatsnummer: