Custom Function to find value and offset

[silentwolf]

Hi guys,
I am in need for help.(
I would like to write a custom function which findes certain values and offset once it is found two columns to the right.

function Test(strText as string) as string
Select Case True
Case strText = "Good"
?? offset found cell one column to the right get and modify that cell
Case strText="Bad"
?? offset found cell one column to the right get and modify that cell
Case strText ="Worst"
?? offset found cell one column to the right get and modify that cell
Case else

End select
end function

That is what I like to have but I am not able to get it to work...

Many thanks for your helb

Greetings

Albert

 

[Norie]

You shouldn't need to refer to the cells on the worksheet for this, everything should be in the array that you eventually write back to the worksheet in one go.

Which column out of IBAN,Auszugsnummer,Buchungsdatum,Valutadatum,Umsatzzeit,Zahlungsreferenz,Waehrung,Betrag,Buchungstext and Umsatztext has the value that is passed to the function?

Also, which of those columns should the return value from the function go to?

 

[silentwolf]

Hi Norie,
The "Umsatztext" Column ist the one which will be passed into the function and need to be on the same spot again in the worksheet..

Sub CalculateWithArray()
    Dim Umsatztext() As Variant
    Dim Answers() As Variant
    Dim Dimension1 As Long
    Dim Counter As Long
    
    Umsatztext = Range("J2", Range("J1").End(xlDown))
    
    Dimension1 = UBound(Umsatztext, 1)
    
    ReDim Answers(1 To Dimension1, 1)
    
    For Counter = 1 To Dimension1
        Answers(Counter, 1) = LastschriftenTextUpdate(Umsatztext(Counter, 1))
    Next Counter
    
'    Range("J2", Range("J2").Offset(Dimension1 - 1, 1)).Value = Answers
    Range("J2", Range("J2").Offset(Dimension1 - 1, 1)).Value = Answers
    
    Erase Umsatztext
    Erase Answers
End Sub

this is what I tried in the meantime also but it puts the value back into the worksheet but one column to the right .. not back at the same column "J"..

still struggling with arrays

 

[Norie]

If the return value from the function is to go into the same column as the value passed why the mention of offset?

Try this.

Sub LastSchrifenGleicheSpalteBerechnen()
Dim Guthaben() As Variant
Dim r As Range
Dim GuthabenCounter As Long
Dim LoopCounter As Long

    For Each r In Range("A2", Range("A1").End(xlDown))
        If r.Offset(0, 8).Value = "SEPA-Lastschrift" Then
            GuthabenCounter = GuthabenCounter + 1

            ReDim Preserve Guthaben(1 To 10, 1 To GuthabenCounter)

            For LoopCounter = 1 To 9
                Guthaben(LoopCounter, GuthabenCounter) = r.Offset(0, LoopCounter - 1).Value
            Next LoopCounter

            Guthaben(10, GuthabenCounter) = LastschriftenTextUpdate(Guthaben(10, GuthabenCounter))

        End If
    Next r

End Sub

Function LastschriftenTextUpdate(ByVal strText As String) As String

    Select Case True
    
        Case strText Like "*Aktiengesellschaft *"
            intPos = InStr(strText, "Aktiengesellschaft")
            LastschriftenTextUpdate = Left(strText, intPos + 17)

        Case strText Like "*AG *"
            intPos = InStr(strText, "AG")
            LastschriftenTextUpdate = Left(strText, intPos + 2)

        Case strText Like "*GmbH *"
            intPos = InStr(strText, "GmbH")
            LastschriftenTextUpdate = Left(strText, intPos + 3)

        Case strText Like "*GMBH *"
            intPos = InStr(strText, "GMBH")
            LastschriftenTextUpdate = Left(strText, intPos + 3)

        Case strText Like "*Finanzierung*"
            intPos = InStr(strText, "Finanzierung")
            LastschriftenTextUpdate = Left(strText, intPos + 11)
            
        Case Else
            LastschriftenTextUpdate = strText
            
    End Select
    
End Function

 

[silentwolf]

Hi Norie,
we had this already or not?
This is not updateing the cells in column "J" ..
Oh Sorry you changed The
For LoopCounter = 1 to 9...

but still no result shown in the column .(

 

[silentwolf]

The LoopCounter has to be 1 to 10 then it shows me the correct "Answers" In the local window.. but it does not update me the column in the worksheet..
Don't I need to specify where to put the values back into?

 

[Norie]

The loop counter does not have to be 1 to 10 but it makes no difference as after the loop the 10th value in the current row of the array is set using the function.

 

[Norie]

This is the code that's putting the array values onto the new sheet?

Range(ActiveCell, ActiveCell.Offset(UBound(Guthaben, 2) - 1, 9)).Value = Application.Transpose(Guthaben)

Are you sure it's correct?

I would expect to see something like this, using Resize rather than Offset.

Range("A1").Resize(UBound(Guthaben,2), UBound(Guthaben,1)).Value = Application.Transpose(Guthaben)

 

[silentwolf]

Ok Norie,

but if I set it to 1 to 9 the array is empty in the local window...
With 1 to 10 it has the updated values correct in it..
But it does not update any cells in the worksheet..

 

[Norie]

Like I said it doesn't matter if the loop is from 1 to 10 or 1 to 9.

PS What cells are meant to be updated? Aren't you writing the array to a brand new sheet?

 

[silentwolf]

No I need to update the array in the same sheet
That is what is not working.. no transpose or anything like that. I need the array find alle "SEPA-Lastschrift" and update the column with the function...

So there is something missing like

.range(.cells(2,10)=Array

but I can not get it to work ...

The Column ("J") needs to be updated
Still gg ...the column ("J") runs through the function but need to be spit out back into the same worksheet at the same Cell Referenz with the new values...