VBA code? Please Help.

alienscript · #1 (**permalink**) 09-05-04, 16:06

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.

DavidCoutts · #2 (**permalink**) 09-06-04, 06:57

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

alienscript · #3 (**permalink**) 09-06-04, 12:07

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.

alienscript · #4 (**permalink**) 09-07-04, 14:19

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.

DavidCoutts · #5 (**permalink**) 09-08-04, 05:16

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

Internet Services

Web Development

Digital Marketing

Consumer Tech