locked
VBA: Joining UDF and SUBs RRS feed

  • Question

  • Hello, I have made a functin which works properly. But it does the work when you point the cells. I Thought, I could make it more user friendly and use a macro which ask the user for the names of columns and insert the function in a specified range. Thanks to given columns I could use an Offset function to make the calculations. The problem is, that the function return an ARG error. Probably I specified variables in a wrong way or did someting else wrong. Could someone help me to crack this nut ? Here you find the function and the macro:

    Sub kontrola1()
    cKontrola = InputBox("Podaj kolumnę, w której znajduje się Kontrola")
    cSuma = InputBox("Podaj kolumnę, w której znajduje się Suma")
    cWydatkiKwalifikowane = InputBox("Podaj kolumnę, w której znajdują się Wydatki Kwalifikowane")
    cWydatkiBrutto = InputBox("Podaj kolumnę, w której znajdują się Wydatki Brutto")
    cEwid = InputBox("Podaj kolumnę, w której znajduje się Numer Ewidencyjny")
    cWniosek = InputBox("Podaj kolumnę, w której znajduje się Numer Wniosku")

    ccKontrola = Columns(cKontrola).Column
    ccSuma = Columns(cSuma).Column
    ccWydatkiKwalifikowane = Columns(cWydatkiKwalifikowane).Column
    ccWydatkiBrutto = Columns(cWydatkiBrutto).Column
    ccEwid = Columns(cEwid).Column
    ccWniosek = Columns(cWniosek).Column

    lastrow = Cells(ActiveSheet.Rows.Count, Columns(cSuma).Column).End(xlUp).Row

    firstrow = Cells(lastrow, Columns(cKontrola).Column).End(xlUp).Row

    Dim TabelaKontrola As Range

    Set TabelaKontrola = Range(Cells(firstrow, Columns(cKontrola).Column), Cells(lastrow, Columns(cKontrola).Column))

    TabelaKontrola.Formula = "=kontrola(ccSuma, ccWydatkiKwalifikowane, ccWydatkiBrutto, ccEwid, ccWniosek, ccKontrola )"


    End Sub

    Function kontrola(ccSuma As Variant, ccWydatkiKwalifikowane As Variant, ccWydatkiBrutto As Variant, ccEwid As Variant, ccWniosek As Variant, ccKontrola As Variant) As String
      
    rSuma = ccSuma - ccKontrola
    rWydatkiKwalifikowane = ccWydatkiKwalifikowane - ccKontrola
    rWydatkiBrutto = ccWydatkiBrutto - ccKontrola
    rEwid = ccEwid - ccKontrola
    rWniosek = ccWniosek - ccKontrola

    Dim i As Integer
    Dim j As Integer
    Dim TabelaEwid As Range
    Dim TabelaWniosek As Range

    If ActiveCell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then
        kontrola = ""
        Exit Function
    End If
      
    If ActiveCell.Offset(0, rWydatkiKwalifikowane).Value <= ActiveCell.Offset(-1, rWydatkiBrutto).Value Then
        kontrola = "Ok"
        Exit Function
    End If

    Set TabelaEwid = Range(ActiveCell.Offset(-1, rEwid), ActiveCell.Offset(-1, rEwid).End(xlUp))
    Set TabelaWniosek = Range(ActiveCell.Offset(-1, rWniosek), ActiveCell.Offset(-1, rWniosek).End(xlUp))

    kontrola = "ok"

    For i = 1 To TabelaEwid.Cells.Count - 1
        For j = i + 1 To TabelaEwid.Cells.Count
            If TabelaEwid.Cells(i).Value = TabelaEwid.Cells(j).Value And _
               TabelaWniosek.Cells(i).Value <> TabelaWniosek.Cells(j).Value Then
               kontrola = "Kontrola"
               Exit Function
            End If
        Next j
    Next i

    End Function

    Firstly I get the name of column e.g. B . Then I convert it to the number as to 2 in this case and then I try to put it as an argument into my function. For this purpose I use InputBox function.

    Are you able to help me? I would be grateful, I am a very beginner.

    Thank you in advance

    regards

    Radek

    Friday, November 12, 2010 2:08 PM

Answers

  • If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then

    should be

    If Right(cell.Offset(0, rSuma).Value, 4) <> "Suma" Then


    HTH, Bernie
    • Marked as answer by zielllik Saturday, November 13, 2010 10:15 AM
    Friday, November 12, 2010 11:52 PM

All replies

  • This is the initial shape of my function which works well if I point manually at the appropriate cells:

    Function kontrola(Suma As Variant, _

        WydatkiKwalifikowane As Range, _

        WydatkiBrutto As Range, Ewid As Range, _

        Wniosek As Range) As String

      

    Dim i As Integer

    Dim j As Integer

    Dim TabelaEwid As Range

    Dim TabelaWniosek As Range

     

    If Right(Suma, 4) <> "Suma" Then

        kontrola = ""

        Exit Function

    End If

      

    If WydatkiKwalifikowane.Value <= WydatkiBrutto.Value Then

        kontrola = "Ok"

        Exit Function

    End If

     

    Set TabelaEwid = Range(Ewid, Ewid.End(xlUp))

    Set TabelaWniosek = Range(Wniosek, Wniosek.End(xlUp))

     

    kontrola = "ok"

     

    For i = 1 To TabelaEwid.Cells.Count - 1

        For j = i + 1 To TabelaEwid.Cells.Count

            If TabelaEwid.Cells(i).Value = TabelaEwid.Cells(j).Value And _

               TabelaWniosek.Cells(i).Value <> TabelaWniosek.Cells(j).Value Then

               kontrola = "Kontrola"

               Exit Function

            End If

        Next j

    Next i 

    End Function

     

    Friday, November 12, 2010 2:10 PM
  • In function kontrola, try replacing ActiveCell with Application.Caller in all instances.
    HTH, Bernie
    Friday, November 12, 2010 7:47 PM
  • There is the same problem. An ARG error occurs. But, I tried to make only one macro, without joining macro and UDF. But I have problem with the conditions. I gave the commentar which I excpect to get. I try to define conditions in different ways but debugger shows an error and I really do not know how to solve it.

    <!-- [if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:TrackMoves/> <w:TrackFormatting/> <w:HyphenationZone>21</w:HyphenationZone> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:DoNotPromoteQF/> <w:LidThemeOther>PL</w:LidThemeOther> <w:LidThemeAsian>X-NONE</w:LidThemeAsian> <w:LidThemeComplexScript>X-NONE</w:LidThemeComplexScript> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> <w:SplitPgBreakAndParaMark/> <w:DontVertAlignCellWithSp/> <w:DontBreakConstrainedForcedTables/> <w:DontVertAlignInTxbx/> <w:Word11KerningPairs/> <w:CachedColBalance/> </w:Compatibility> <m:mathPr> <m:mathFont m:val="Cambria Math"/> <m:brkBin m:val="before"/> <m:brkBinSub m:val="--"/> <m:smallFrac m:val="off"/> <m:dispDef/> <m:lMargin m:val="0"/> <m:rMargin m:val="0"/> <m:defJc m:val="centerGroup"/> <m:wrapIndent m:val="1440"/> <m:intLim m:val="subSup"/> <m:naryLim m:val="undOvr"/> </m:mathPr></w:WordDocument> </xml><![endif]-->

    Sub kontrola1()

    cKontrola = InputBox("Podaj kolumnę, w której znajduje się Kontrola")

    cSuma = InputBox("Podaj kolumnę, w której znajduje się Suma")

    cWydatkiKwalifikowane = InputBox("Podaj kolumnę, w której znajdują się Wydatki Kwalifikowane")

    cWydatkiBrutto = InputBox("Podaj kolumnę, w której znajdują się Wydatki Brutto")

    cEwid = InputBox("Podaj kolumnę, w której znajduje się Numer Ewidencyjny")

    cWniosek = InputBox("Podaj kolumnę, w której znajduje się Numer Wniosku")

     

    ccKontrola = Columns(cKontrola).Column

    ccSuma = Columns(cSuma).Column

    ccWydatkiKwalifikowane = Columns(cWydatkiKwalifikowane).Column

    ccWydatkiBrutto = Columns(cWydatkiBrutto).Column

    ccEwid = Columns(cEwid).Column

    ccWniosek = Columns(cWniosek).Column

     

    lastrow = Cells(ActiveSheet.Rows.Count, Columns(cSuma).Column).End(xlUp).Row

     

    firstrow = Cells(lastrow, Columns(cKontrola).Column).End(xlUp).Row

     

    rSuma = ccSuma - ccKontrola

    rWydatkiKwalifikowane = ccWydatkiKwalifikowane - ccKontrola

    rWydatkiBrutto = ccWydatkiBrutto - ccKontrola

    rEwid = ccEwid - ccKontrola

    rWniosek = ccWniosek - ccKontrola

     

    Dim i As Integer

    Dim j As Integer

    Dim TabelaEwid As Range

    Dim TabelaWniosek As Range

    Dim TabelaKontrola As Range

     

     

    Set TabelaKontrola = Range(Cells(firstrow, Columns(cKontrola).Column), Cells(lastrow, Columns(cKontrola).Column))

     

    TabelaKontrola.Select

     

    For Each cell In Selection

     

    If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then

    cell.Value = ""

    End If     'if this contition is not met I want to go to the next cell in a range leaving empty cell ("") and it should not check the next condidion

     

    If cell.Offset(0, rWydatkiKwalifikowane).Value <= cell.Offset(-1, rWydatkiBrutto).Value Then

    cell.Value = "Ok"  ' if this condition is met I want to go to the next cell leaving "Ok" in a cell. But the above condidion has to be met

     

    Else  ' if the first condition is met and the second is not met I want to do this procedure

    cell.Value = "Ok"

     

    Set TabelaEwid = Range(cell.Offset(-1, rEwid), cell.Offset(-1, rEwid).End(xlUp))

    Set TabelaWniosek = Range(cell.Offset(-1, rWniosek), cell.Offset(-1, rWniosek).End(xlUp))

     

    For i = 1 To TabelaEwid.Cells.Count - 1

        For j = i + 1 To TabelaEwid.Cells.Count

            If TabelaEwid.Cells(i).Value = TabelaEwid.Cells(j).Value And _

               TabelaWniosek.Cells(i).Value <> TabelaWniosek.Cells(j).Value Then

               cell.Value = "Kontrola"

            End If

        Next j

    Next i

    End If

    Next cell

     

     

    End Sub

     

    Any help possible? Bernie you have helped me with this procedure yet. Than you again. Could you maybe help me solve the problem this time?

     

    regards

     

    Radek

    Friday, November 12, 2010 8:57 PM
  • I wrote the wrong commentar.  Once again:

    Sub kontrola1()
    cKontrola = InputBox("Podaj kolumnę, w której znajduje się Kontrola")
    cSuma = InputBox("Podaj kolumnę, w której znajduje się Suma")
    cWydatkiKwalifikowane = InputBox("Podaj kolumnę, w której znajdują się Wydatki Kwalifikowane")
    cWydatkiBrutto = InputBox("Podaj kolumnę, w której znajdują się Wydatki Brutto")
    cEwid = InputBox("Podaj kolumnę, w której znajduje się Numer Ewidencyjny")
    cWniosek = InputBox("Podaj kolumnę, w której znajduje się Numer Wniosku")

    ccKontrola = Columns(cKontrola).Column
    ccSuma = Columns(cSuma).Column
    ccWydatkiKwalifikowane = Columns(cWydatkiKwalifikowane).Column
    ccWydatkiBrutto = Columns(cWydatkiBrutto).Column
    ccEwid = Columns(cEwid).Column
    ccWniosek = Columns(cWniosek).Column

    lastrow = Cells(ActiveSheet.Rows.Count, Columns(cSuma).Column).End(xlUp).Row

    firstrow = Cells(lastrow, Columns(cKontrola).Column).End(xlUp).Row

    rSuma = ccSuma - ccKontrola
    rWydatkiKwalifikowane = ccWydatkiKwalifikowane - ccKontrola
    rWydatkiBrutto = ccWydatkiBrutto - ccKontrola
    rEwid = ccEwid - ccKontrola
    rWniosek = ccWniosek - ccKontrola

    Dim i As Integer
    Dim j As Integer
    Dim TabelaEwid As Range
    Dim TabelaWniosek As Range
    Dim TabelaKontrola As Range


    Set TabelaKontrola = Range(Cells(firstrow, Columns(cKontrola).Column), Cells(lastrow, Columns(cKontrola).Column))

    TabelaKontrola.Select

    For Each cell In Selection

    If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then
    cell.Value = ""
    End If       'if this contition is met I want to go to the next cell in a range leaving empty cell ("") and it should not check the next condidion

    If cell.Offset(0, rWydatkiKwalifikowane).Value <= cell.Offset(-1, rWydatkiBrutto).Value Then
    cell.Value = "Ok"  ' if this condition is met I want to go to the next cell leaving "Ok" in a cell. But the above condidion has not to be met

    Else  ' if the first condition is not met and the second is not met I want to do this procedure
    cell.Value = "Ok"

    Set TabelaEwid = Range(cell.Offset(-1, rEwid), cell.Offset(-1, rEwid).End(xlUp))
    Set TabelaWniosek = Range(cell.Offset(-1, rWniosek), cell.Offset(-1, rWniosek).End(xlUp))

    For i = 1 To TabelaEwid.Cells.Count - 1
        For j = i + 1 To TabelaEwid.Cells.Count
            If TabelaEwid.Cells(i).Value = TabelaEwid.Cells(j).Value And _
               TabelaWniosek.Cells(i).Value <> TabelaWniosek.Cells(j).Value Then
               cell.Value = "Kontrola"
            End If
        Next j
    Next i
    End If
    Next cell


    End Sub

    Friday, November 12, 2010 9:11 PM
  • It is next to impossible to fix code without knowing the tables and workbook layouts. Could you send me a sample, and let me know what I should respond to the questions?

    bdeitrick at alum dot mit dot edu


    HTH, Bernie
    Friday, November 12, 2010 9:49 PM
  • I have problem with for each ... next statement. I would want to go through each cell in a range, check conditions and do the work depending on whether they are met or not as to my commentars. I think that it is possible that the code is written well till the for each ... next statement, because the debugger highlight this part (If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then) and shows statement like as follows:  Object doesn't support this property or method (Error 438). There are three conditions : if the first is met there should appear nothing in a cell and we go to the next cell without investigating next conditions, if not we check the second condition. If it is met there should appear "Ok" in a cell and we go to the next cell. If the first condition is not met and the second is not met I want to run the procedure, which you have helped me to write. I think that tere is a problem with joining For each ... next statement with the condidions and procedure.

     

    As to the sample: I am able to prepare some, but how could I attached the file here?

     

    one more time my code:

    Sub kontrola1()

    cKontrola = InputBox("Podaj kolumnę, w której znajduje się Kontrola")
    cSuma = InputBox("Podaj kolumnę, w której znajduje się Suma")
    cWydatkiKwalifikowane = InputBox("Podaj kolumnę, w której znajdują się Wydatki Kwalifikowane")
    cWydatkiBrutto = InputBox("Podaj kolumnę, w której znajdują się Wydatki Brutto")
    cEwid = InputBox("Podaj kolumnę, w której znajduje się Numer Ewidencyjny")
    cWniosek = InputBox("Podaj kolumnę, w której znajduje się Numer Wniosku")

    ccKontrola = Columns(cKontrola).Column
    ccSuma = Columns(cSuma).Column
    ccWydatkiKwalifikowane = Columns(cWydatkiKwalifikowane).Column
    ccWydatkiBrutto = Columns(cWydatkiBrutto).Column
    ccEwid = Columns(cEwid).Column
    ccWniosek = Columns(cWniosek).Column

    lastrow = Cells(ActiveSheet.Rows.Count, Columns(cSuma).Column).End(xlUp).Row

    firstrow = Cells(lastrow, Columns(cKontrola).Column).End(xlUp).Row

    rSuma = ccSuma - ccKontrola
    rWydatkiKwalifikowane = ccWydatkiKwalifikowane - ccKontrola
    rWydatkiBrutto = ccWydatkiBrutto - ccKontrola
    rEwid = ccEwid - ccKontrola
    rWniosek = ccWniosek - ccKontrola

    Dim i As Integer
    Dim j As Integer
    Dim TabelaEwid As Range
    Dim TabelaWniosek As Range
    Dim TabelaKontrola As Range


    Set TabelaKontrola = Range(Cells(firstrow, Columns(cKontrola).Column), Cells(lastrow, Columns(cKontrola).Column))

    TabelaKontrola.Select

    For Each cell In Selection

    If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then
    cell.Value = ""
    End If       'if this contition is met I want to go to the next cell in a range leaving empty cell ("") and it should not check the next condidion

    If cell.Offset(0, rWydatkiKwalifikowane).Value <= cell.Offset(-1, rWydatkiBrutto).Value Then
    cell.Value = "Ok"  ' if this condition is met I want to go to the next cell leaving "Ok" in a cell. But the above condidion can not be met

    Else  ' if the first condition is not met and the second is not met I want to do this procedure
    cell.Value = "Ok"

    Set TabelaEwid = Range(cell.Offset(-1, rEwid), cell.Offset(-1, rEwid).End(xlUp))
    Set TabelaWniosek = Range(cell.Offset(-1, rWniosek), cell.Offset(-1, rWniosek).End(xlUp))

    For i = 1 To TabelaEwid.Cells.Count - 1
        For j = i + 1 To TabelaEwid.Cells.Count
            If TabelaEwid.Cells(i).Value = TabelaEwid.Cells(j).Value And _
               TabelaWniosek.Cells(i).Value <> TabelaWniosek.Cells(j).Value Then
               cell.Value = "Kontrola"
            End If
        Next j
    Next i
    End If
    Next cell

    End Sub

     

    Best regards

     

    Radek

    Friday, November 12, 2010 10:13 PM
  • If cell.Offset(0, rSuma).Right(Suma, 4) <> "Suma" Then

    should be

    If Right(cell.Offset(0, rSuma).Value, 4) <> "Suma" Then


    HTH, Bernie
    • Marked as answer by zielllik Saturday, November 13, 2010 10:15 AM
    Friday, November 12, 2010 11:52 PM
  • Thank you, I must be really beginner to overlook something like that.

     

    best regards

     

    Radek

    Saturday, November 13, 2010 10:15 AM