Excel Macro issue: 1) Type mismatch on date 2) Setting complex condition

Sorry for the confusing title. But I can't think of a better way of describing my problem.

I have a sheet of data in Excel that merges data from 2 separate sheets, places them in an allocation sheet and finally put them in another worksheet for display. Currently the display is like so:

+----+-----------+---------+-----------+---------+--------+
| NO |   Date    | Header  | Line Item | GL Acc  | Amount |
+----+-----------+---------+-----------+---------+--------+
|  1 | 20171031  | Header1 |     1     | 1000001 | 9.50   |  
|  1 |           |         |     2     | 1000001 | -9.50  | 
                              .
                              .
                              . 
|  1 |           |         |    901    | 1000002 | 6.80   |
|  1 |           |         |    902    | 1000002 | -6.80  |
+----+-----------+---------+-----------+---------+--------+

Note that this is a simplified table. When this table is running there can be up to thousands of rows of data. Now I would like to make it so that the table will create a new Date and Header date and restart the Line Item to 1 again when it reaches 900 count. However there is also the condition that the GL Acc cannot have any balance when it is separating.

For Example:

+----+-----------+---------+-----------+---------+--------+
| NO |   Date    | Header  | Line Item | GL Acc  | Amount |
+----+-----------+---------+-----------+---------+--------+
| 1  | 20171031  | Header1 |    1      | 1000001 | 9.50   |
| 1  |           |         |    2      | 1000001 | -9.50  |
                              .
                              .
                              . 
|  2 |           |         |    1      | 1000002 | 6.80   |
|  2 |           |         |    2      | 1000002 | -6.80  |
+----+-----------+---------+-----------+---------+--------+

This is the original code snippet for the module:

Sub upload_Entry()
Dim NextID
Dim CID
Dim Header
Dim accdate, accdate1
Header = 1
NextID = 0
runv = 3
SQID = 0
LastRow = ActiveWorkbook.Sheets("ALLOCATION").Cells(7, 10) * 2

For C = 3 To ((LastRow + 2))

    SQID = SQID + 1
    If Header = 1 Then
        accdate = ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2)
        accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = accdate1       ' DOC_DATE
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 3) = "Header1"
        Header = 0
    End If

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 4) = SQID 'Line Item
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13) * -1    'Amount
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 1) = 1  'NO

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 1) = 1 ' NO
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 4) = SQID + 1
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13)

Sorry for the messy code. The original was much worse.

My 1st agenda was to make it so that the date and header can create in different rows since the code only shows it placing those values on the 1st row only.

Thus I came up with this code:

Sub upload_Entry()
    Dim NextID
    Dim CID
    Dim Header
    Dim accdate
    Header = 1
    NextID = 0
    runv = 3
    SQID = 0
    LastRow = ActiveWorkbook.Sheets("ALLOCATION").Cells(7, 10) * 2 'dictaces how many rows created     

     For C = 3 To ((LastRow + 2))

    CID = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 2) 'B9

    If NextID <> CID Then
    'If Header = 1 Then
        SQID = 0
        SQID = SQID + 1

        accdate = ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2)  ' or Cells(5, 2)//B5
        accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0) 
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = accdate1
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 3) = "Header1"
    Else
        SQID = SQID + 1
    End If

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 4) = SQID
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13) * -1 'Amount

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 1) = CID ' id
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 1) = CID ' id
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 4) = SQID + 1
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACCT
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 17) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13)   'Amount

    NextID = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 2)
    C = C + 1
    runv = runv + 1
    SQID = SQID + 1

      Next C
End Sub

The good news is I managed to get the Header to duplicate. But the Date shows Type Mismatch on code:

accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)

Edit Start

The date comes from a sheet where its format is only year and month (201710), when using the original code, the accdate1 code help me get the default last day of the month and fills the complete date in the sheet (20171031).

Edit End

Thus that is one problem I have. Another major problem is I'm not sure how to set such a complex condition on separating line into new NO when rows reaches 900 and also keep track the balance at the same time.

Is there anyone out there that can help? The more I try and solve this the more cross-eyed I become. Thanks in advance.

1 answer

  • answered 2017-10-11 10:10 JonRo

    For the example with Date=20171031, DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0) is gonna fail in giving the next day as a result. Maybe these changes ?

    Dim D as Date
    ...
    If IsDate(accdate) Then
        D = DateSerial(Left(accdate, 4), Mid(accdate, 5, 2), Right(accdate, 2))
        D = D + 1
    Else
        D = DateSerial(1983, 1, 19) ' launch date of Apple Lisa
    End If
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = Format(D, "yyyymmdd")