Results 1 to 5 of 5
  1. #1
    Join Date
    Jul 2004
    Posts
    23

    Unanswered: VBA code? Please Help.

    Hi VBA gurus,

    I have Access RunMacro to run my 22 macro Actions and exports the table as a spreadsheet. Now my only hurdle is not able to formulate the Remarks in column AC as in the attached data.xls because there seems to be too many nested-ifs required than I am able capable to do so.

    I really appreciate if someone be nice and please help me with the Excel formulas or the VBA code to complete the Remark entries in column AC.

    Thanks so much in advance.
    Attached Files Attached Files

  2. #2
    Join Date
    Jan 2004
    Location
    Aberdeen, Scotland
    Posts
    1,067
    ok here is one way you could go, by creating a function like this it could do your processing for you

    Code:
    Function FillRemarks(ByVal rngUse As Range) As String
        Dim date1 As String, date2 As String
        Dim strRem1 As String, strRem2 As String, StrRem3 As String
        Dim myDate As Date, Amount As Integer
        
        'determine inital amount to work with
        Amount = Range("O" & rngUse.Row).Value + Range("Z" & rngUse.Row).Value + _
                    Range("AB" & rngUse.Row).Value
                    
        'get dates from number group
        date1 = Left(Range("Y" & rngUse.Row), 2) & "/" & _
                        Right(Left(Range("Y" & rngUse.Row), 4), 2) & "/" & _
                        Right(Range("Y" & rngUse.Row), 4)
        
        date2 = Left(Range("AA" & rngUse.Row), 2) & "/" & _
                        Right(Left(Range("Y" & rngUse.Row), 4), 2) & "/" & _
                        Right(Range("AA" & rngUse.Row), 4)
        
        
        
        If Range("P" & rngUse.Row).Value = "Yes" Then
            strRem1 = "Enough qty-on-Hand"
        Else
        
            'fill first part depending on value of Q
            If Range("Q" & rngUse.Row).Value = "Yes" Then
                strRem1 = "Partial qty-on-Hand, "
                If Amount >= Range("D" & rngUse.Row).Value Then
                    strRem2 = "enough bal. "
                Else
                    strRem2 = "partial bal. "
                End If
            Else
                If Amount >= Range("D" & rngUse.Row).Value Then
                    strRem2 = "Enough qty "
                Else
                    strRem2 = "Partial qty "
                End If
            End If
        
            'check dates to get my date
            If date1 >= date2 Then
                myDate = CDate(date1) + 10
            Else
                myDate = CDate(date2) + 10
            End If
            
            'derive last part of string from empty cell
            If IsEmpty(Range("AA" & rngUse.Row)) Then
                StrRem3 = "arrive on " & Format(myDate, "dd/mm")
            Else
                StrRem3 = "arrive latest " & Format(myDate, "dd/mm")
            End If
            
         
        End If
                
        FillRemarks = Trim(strRem1 & strRem2 & StrRem3)
    End Function
    and to use it type =FillRemarks(A2) where A2 is a cell within the row you want to calculate the remarks for.

    HTH

    Dave

  3. #3
    Join Date
    Jul 2004
    Posts
    23

    VB code -should display 22/09 not 19/12. Please help..

    Hi Dave,

    I am so glad your Function code works like magic.
    Thanks so much for your help.

    There is a little error mismatch here..
    Cell AC5 displays "Partial qty-on-Hand, enough bal. arrive latest 19/12" which should in fact be "Partial qty-on-hand, enough bal. arrive latest on 22/09".
    This is because 12092004 + additional 10 days should be 22/09.

    Would you please help me with this little bug?

    Thanks very much.

  4. #4
    Join Date
    Jul 2004
    Posts
    23

    Smile VBA code? 3 additional criteria, Please Help..

    Hi Dave,

    I run my office data spreadsheet and discovered there are 3 more criteria that are not being captured in the VB code and results in "#VALUE!"

    I attached the zipped spreadsheet data1.xls and included inside the additional three criteria and the desired remarks in rows 9 to 11.

    Kindly Please help me with this last thing left and it surely would save me many many hours at work than having to do both manual filtering and entries laboriously.

    Thanks a million.
    Attached Files Attached Files

  5. #5
    Join Date
    Jan 2004
    Location
    Aberdeen, Scotland
    Posts
    1,067
    Right ive looked at this Function for you and produced an updated version of the code
    ive been unable to reproduce the behaviour above with the wrong dates inserted
    also row 11 appears to be of identical form to row 7 on your worksheet so i have not handled this situation.

    Here is the revised code for you
    Code:
    Function FillRemarks(ByVal rngUse As Range) As String
    'Fill Remarks Function used for producing The Remarks Column
    'Written by David Coutts(DB Forums) on 07/09/04
    'Update on 09/07/04 to include different remarks and general tidy up
    
    'to use this Function type =FillRemarks(A2)
    'where A2 is a cell within the row you want to calculate the remarks for.
    
        Dim date1 As String, date2 As String
        Dim strRem1 As String, strRem2 As String, StrRem3 As String
        Dim myDate As Date, Amount As Integer
        Dim bolEmpty As Boolean
        
        
        'Get Variables for Use
        
        'Set Default Values of Strings
        'update to remove #VALUE! on 08/09/04
        strRem1 = "": strRem2 = "": StrRem3 = ""
        
        'determine inital amount to work with
        Amount = Cells(rngUse.Row, Range("O1").Column).Value + _
                    Cells(rngUse.Row, Range("Z1").Column).Value + _
                    Cells(rngUse.Row, Range("AB1").Column).Value
                    
        'set bolEmpty to check if both column Y and Column AA are Empty
        
        bolEmpty = IsEmpty(Cells(rngUse.Row, Range("Y1").Column)) And _
                    IsEmpty(Cells(rngUse.Row, Range("AA1").Column))
        
        'get dates from number group
        date1 = Left(Cells(rngUse.Row, Range("Y1").Column), 2) & "/" & _
                        Right(Left(Cells(rngUse.Row, Range("Y1").Column), 4), 2) & "/" & _
                        Right(Cells(rngUse.Row, Range("Y1").Column), 4)
        
        date2 = Left(Cells(rngUse.Row, Range("AA1").Column), 2) & "/" & _
                        Right(Left(Cells(rngUse.Row, Range("AA1").Column), 4), 2) & "/" & _
                        Right(Cells(rngUse.Row, Range("AA1").Column), 4)
        
        
        'check dates to get my date
        If bolEmpty Then
            'if column Y and Column AA are null the Date = Today + 10 days
            myDate = Date + 15
        ElseIf date1 >= date2 Then
        'find the largest date and add 10 to it
            myDate = CDate(date1) + 10
        Else
            myDate = CDate(date2) + 10
        End If
        
        
        
        'Set String Values
        ' If the value in column P is yes remark as below
        If Cells(rngUse.Row, Range("P1").Column).Value = "Yes" Then
            strRem1 = "Enough qty-on-Hand"
        ElseIf Cells(rngUse.Row, Range("P1").Column).Value = "No" Then
            'fill first part depending on value of Q
            If Cells(rngUse.Row, Range("Q1").Column).Value = "Yes" Then
                strRem1 = "Partial qty-on-Hand, "
                If Amount >= Cells(rngUse.Row, Range("D1").Column).Value Then
                    strRem2 = "enough bal. "
                Else
                    strRem2 = "partial bal. "
                End If
            ElseIf Cells(rngUse.Row, Range("Q1").Column).Value = "No" Then
                If Amount >= Cells(rngUse.Row, Range("D1").Column).Value Then
                    strRem2 = "Enough qty "
                Else
                    strRem2 = "Partial qty "
                End If
            End If
        
    
            'derive last part of string from empty cell
            If bolEmpty Then
                strRem1 = "No qty-on-hand "
                StrRem3 = "and expediting *ETA " & Format(myDate, "dd/mm")
            ElseIf IsEmpty(Cells(rngUse.Row, Range("AA1").Column)) Then
                StrRem3 = "arrive on " & Format(myDate, "dd/mm")
            Else
                StrRem3 = "arrive latest " & Format(myDate, "dd/mm")
            End If
                 
        End If
             
             
        'produce output from the created strings
        FillRemarks = Trim(strRem1 & strRem2 & StrRem3)
    End Function
    Dave

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •