optimise code -> subroutine to function (paramarray??!)

[tozjerimiah]

Currently I do this:

Code:

    For CurrentTableRow = WallTableBeginsRow To WallTableBeginsRow + NumberOfWalls
        If (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "GF") Then
            GFBWKArrayNumber = GFBWKArrayNumber + 1
            ReDim Preserve GFBWK(1 To GFBWKArrayNumber)
            GFBWK(GFBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "GF") Then
            GFBLKArrayNumber = GFBLKArrayNumber + 1
            ReDim Preserve GFBLK(1 To GFBLKArrayNumber)
            GFBLK(GFBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "FF") Then
            FFBWKArrayNumber = FFBWKArrayNumber + 1
            ReDim Preserve FFBWK(1 To FFBWKArrayNumber)
            FFBWK(FFBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "FF") Then
            FFBLKArrayNumber = FFBLKArrayNumber + 1
            ReDim Preserve FFBLK(1 To FFBLKArrayNumber)
            FFBLK(FFBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "TOP") Then
            TOPBWKArrayNumber = TOPBWKArrayNumber + 1
            ReDim Preserve TOPBWK(1 To TOPBWKArrayNumber)
            TOPBWK(TOPBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * (" & (Cells(CurrentTableRow, HeightCol).Value) & " /2)"
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "TOP") Then
            TOPBLKArrayNumber = TOPBLKArrayNumber + 1
            ReDim Preserve TOPBLK(1 To TOPBLKArrayNumber)
            TOPBLK(TOPBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * (" & (Cells(CurrentTableRow, HeightCol).Value) & " /2)"
        Else: End If
    Next CurrentTableRow

I want to optimise this by turning it into a function; basically it extracts data from a table based on parameters...

You will notice that each of the above conditions only use 2 parameters, however I would like to be able to pass the function any number... so what I'm thinking is basically:

allBrick = functionname(table (search_one, search_two), (search_one, search_three, search_four))

I guess that the function would return an array...

I hope that this makes sense... knowing that what I am wanting to do is possible would be a great start!!

Thanks

 

[dragontooth]

I have no way of testing this so I will have to depend on you

I made a HUGE assumtion, that is that the cells object will still be available otherwise I will have to rework it some.

Below is your code "modified" to use the sub.

For CurrentTableRow = WallTableBeginsRow To WallTableBeginsRow + NumberOfWalls
        If (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "GF") Then
            AddArrayElement GFBWKArrayNumber, GFBWK, CurrentTableRow, LengthCol, HeightCol
'            GFBWKArrayNumber = GFBWKArrayNumber + 1
'            ReDim Preserve GFBWK(1 To GFBWKArrayNumber)
'            GFBWK(GFBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "GF") Then
            AddArrayElement GFBLKArrayNumber, GFBLK, CurrentTableRow, LengthCol, HeightCol
'            GFBLKArrayNumber = GFBLKArrayNumber + 1
'            ReDim Preserve GFBLK(1 To GFBLKArrayNumber)
'            GFBLK(GFBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "FF") Then
            AddArrayElement FFBWKArrayNumber, FFBWK, CurrentTableRow, LengthCol, HeightCol
'            FFBWKArrayNumber = FFBWKArrayNumber + 1
'            ReDim Preserve FFBWK(1 To FFBWKArrayNumber)
'            FFBWK(FFBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "FF") Then
            AddArrayElement FFBLKArrayNumber, FFBLK, CurrentTableRow, LengthCol, HeightCol
'            FFBLKArrayNumber = FFBLKArrayNumber + 1
'            ReDim Preserve FFBLK(1 To FFBLKArrayNumber)
'            FFBLK(FFBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * " & (Cells(CurrentTableRow, HeightCol).Value)
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Bwk") And (Cells(CurrentTableRow, FloorCol).Value = "TOP") Then
            AddArrayElement TOPBWKArrayNumber, TOPBWK, CurrentTableRow, LengthCol, HeightCol, " /2)"
'            TOPBWKArrayNumber = TOPBWKArrayNumber + 1
'            ReDim Preserve TOPBWK(1 To TOPBWKArrayNumber)
'            TOPBWK(TOPBWKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * (" & (Cells(CurrentTableRow, HeightCol).Value) & " /2)"
        ElseIf _
        (Cells(CurrentTableRow, BwkBlkStudCol).Value = "Blk") And (Cells(CurrentTableRow, FloorCol).Value = "TOP") Then
            AddArrayElement TOPBLKArrayNumber, TOPBLK, CurrentTableRow, LengthCol, HeightCol, " /2)"
'            TOPBLKArrayNumber = TOPBLKArrayNumber + 1
'            ReDim Preserve TOPBLK(1 To TOPBLKArrayNumber)
'            TOPBLK(TOPBLKArrayNumber) = (Cells(CurrentTableRow, LengthCol).Value) & " * (" & (Cells(CurrentTableRow, HeightCol).Value) & " /2)"
        Else: End If
    Next CurrentTableRow
 
' Here is the sub you asked for
 
Sub AddArrayElement(Cnt As Long, arrArray(), CTR As Long, LC As Long, HC As Long, Optional DB2 As String)
    Cnt = Cnt + 1
    ReDim Preserve arrArray(1 To Cnt)
    arrArray(Cnt) = (Cells(CTRow, LC).Value) & " * (" & (Cells(CTR, HC).Value) & IIf(DB2 <> "", " /2)", ")")
End Sub

 

[tozjerimiah]

Hi there, thanks for your help... I have replaced my old code with yours, obviously putting the new sub in a separate subroutine. However when I run it, I get a ByRef Arguement Type Mismatch compile error... I have uploaded the spreadsheet, in the hope that you will have a look.
Thanks

 

[dragontooth]

I will have to look at this at home later, I am blocked from work.

 

[tozjerimiah]

Thank you v much.

 

[dragontooth]

I had a typo, the type declarations I had were not what you had so this is what I got to work.

Sub AddArrayElement(Cnt, arrArray() As String, CTR, LC, HC, Optional DB2 As String)
    Cnt = Cnt + 1
    ReDim Preserve arrArray(1 To Cnt)
    arrArray(Cnt) = (Cells(CTR, LC).Value) & " * (" & (Cells(CTR, HC).Value) & IIf(DB2 <> "", " /2)", ")")
End Sub

 

[Biz]

Too many elseif.

Try using Case Statements

 

[Norie]

What is this code meant to do?

If you want to use a ParamArray I think we'd need to know that so we can see what parameters are actually involved.