0

I have a code that used information from worksheets to create arrays. It then fills the arrays (given some criteria), create a new workbook and past the transpose of this array to the workbook.

Instead of doing this multiple time (one for each output file), I am trying to create a function that does exactly the same thing. Problem is I don't know how to call this function from the code (without assigning variables).

Code is as follows:

Sub FixerAndExporter()
Dim w As Workbook
Dim w2 As Workbook
Dim WSArray() As Variant, PArray() As Variant, P0Array() As Variant
Dim lRow As Long, lColumn As Long
Dim Pr As Integer, Pr0 As Integer
Dim ws As Worksheet     

Set w = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In w.Worksheets
    If ws.Name = "Pr" Then

        PArray = ws.UsedRange.Value

    ElseIf ws.Name = "Pr0" Then

        P0Array = ws.UsedRange.Value

    End If

 Next ws

'this is what I don't know how to do:
'ArrayFiller(PArray, P0Array)

'what the code is doing is this: 


    For lRow = LBound(PArray, 1) To UBound(PArray, 1)
            For lColumn = LBound(PArray, 2) + 1 To UBound(PArray, 2)
                If PArray(lRow, lColumn) <> "" And PArray(lRow, lColumn - 1) = "" Then

                        If P0Array(lRow, lColumn) <> "" And P0Array(lRow, lColumn) <> "--" Then
                            PArray(lRow, lColumn - 1) = P0Array(lRow, lColumn)
                            'PArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                        ElseIf P0Array(lRow, lColumn) = "" Or P0Array(lRow, lColumn) = "--" Then
                            PArray(lRow, lColumn - 1) = PArray(lRow, lColumn)
                            'PArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                        End If

                End If
            Next
    Next


 Workbooks.Add

 Set w2 = ActiveWorkbook
 w2.Sheets("Sheet1").Range("A1").Resize(UBound(PArray, 2), UBound(PArray, 1)) = Application.WorksheetFunction.Transpose(PArray())

 w2.SaveAs Filename:=ThisWorkbook.path & "\POutput", FileFormat:=6


    w2.Close True


End Sub

And this is the function:

Function ArrayFiller(arr As Variant, arr0 As Variant) As Variant
Dim lRow As Long, lColumn As Long
Dim w2 As Workbook

Workbooks.Add

    For lRow = LBound(arr, 1) To UBound(arr, 1)
        For lColumn = LBound(arr, 2) + 1 To UBound(arr, 2)
            If arr(lRow, lColumn) <> "" And arr(lRow, lColumn - 1) = "" Then

                    If arr0(lRow, lColumn) <> "" And arr0(lRow, lColumn) <> "--" Then
                        arr(lRow, lColumn - 1) = arr0(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                    ElseIf arr0(lRow, lColumn) = "" Or arr0(lRow, lColumn) = "--" Then
                        arr(lRow, lColumn - 1) = arr(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)
                    End If
            End If
        Next
    Next

Set w2 = ActiveWorkbook

w2.Sheets("Sheet1").Range("A1").Resize(UBound(PriceArray, 2), UBound(PriceArray, 1)) = Application.WorksheetFunction.Transpose(PriceArray())

w2.SaveAs Filename:=ThisWorkbook.path & "\PriceOutput.xls", FileFormat:=6

w2.Close True

Set w = ActiveWorkbook

End Function

The code is already working. My doubt would be how to use the function directly, so I don't have to write that block of code over and over for each new different item I need (there are multiple).

Any suggestions?

4
  • To call a Function you just need to use the exact line that you put as a comment: So you would have ArrayFiller(PArray, P0Array) and then once the function has executed its lines it will come back to the original Sub. Im not sure I understand the problem fully Commented Jan 17, 2017 at 13:31
  • Remove the parentheses: ArrayFiller PArray, P0Array. You also have a syntax error with .Transpose(PriceArray()). Remove the parentheses there too (and either declare the array as a variable or change the name to what it should actually be). Commented Jan 17, 2017 at 13:32
  • @Comintern That worked like magic. Many Thanks. Care to write it as an answer, so I can mark it? Commented Jan 17, 2017 at 13:49
  • @DGMS89 : See my answer and furthermore, the links to documentation I added in it! Commented Jan 17, 2017 at 13:57

1 Answer 1

1

You should use Option Explicit (at the start of each module)!

Because with the function you wrote, you'll output nothing as PriceArray isn't defined nor filled!


With what you have written, a function is no use as you don't output anything, you could just use a sub with arguments.

Sub FixerAndExporter()
Dim w As Workbook
Dim WSArray() As Variant, PArray() As Variant, P0Array() As Variant
Dim lRow As Long, lColumn As Long
Dim Pr As Integer, Pr0 As Integer
Dim ws As Worksheet

Set w = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In w.Worksheets
    If ws.Name = "Pr" Then
        PArray = ws.UsedRange.Value
    ElseIf ws.Name = "Pr0" Then
        P0Array = ws.UsedRange.Value
    End If
Next ws

Dim PathToOutputFile As String
PathToOutputFile = ArrayFiller(PArray, P0Array)
MsgBox PathToOutputFile


End Sub

And the function (with an output)

Function ArrayFiller(arr As Variant, arr0 As Variant) As String
    Dim lRow As Long, lColumn As Long
    Dim w2 As Workbook
    Dim TempStr As String

    For lRow = LBound(arr, 1) To UBound(arr, 1)
        For lColumn = LBound(arr, 2) + 1 To UBound(arr, 2)
            If arr(lRow, lColumn) <> "" And arr(lRow, lColumn - 1) = "" Then

                    If arr0(lRow, lColumn) <> "" And arr0(lRow, lColumn) <> "--" Then
                        arr(lRow, lColumn - 1) = arr0(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                    ElseIf arr0(lRow, lColumn) = "" Or arr0(lRow, lColumn) = "--" Then
                        arr(lRow, lColumn - 1) = arr(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)
                    End If
            End If
        Next lColumn
    Next lRow

    TempStr = ThisWorkbook.Path & "\PriceOutput.xls"

    Set w2 = Workbooks.Add
    With w2
        .Sheets(1).Range("A1").Resize(UBound(arr, 2), UBound(arr, 1)) = Application.WorksheetFunction.Transpose(arr())
        .SaveAs Filename:=TempStr, FileFormat:=6
        .Close True
    End With 'w2
    Set w2 = Nothing

ArrayFiller = TempStr
End Function
Sign up to request clarification or add additional context in comments.

1 Comment

Thanks for the answer. Apologies for the PriceArray, that was a typo when I transferred the code to this post. It Should just be PArray. Other than that your code works just fine.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.