VBA Excel Macro missing first date entry

[BeckyMc]

I have the following table

Item Descr Date Qty/Rate
a aaa 7/24/2018 504
a aaa 9/18/2018 504
a aaa 11/2/2018 504
b bbb 7/31/2018 756
b bbb 8/15/2018 168
b bbb 9/21/2018 756
b bbb 10/19/2018 756
b bbb 11/16/2018 756
b bbb 12/14/2018 756
b bbb 2/8/2019 756
c ccc 9/4/2018 100
d d 10/5/2018 200
e e 8/6/2018 12

I have the following code. I want to concatenate dates and amounts in a string per item. However I keep skipping or missing the first date. If there's only one entry it misses that item all together. Why am I missing the first entry?

Sub Button1_Click()


Dim CurItem As String
Dim PromDate As String
Dim NumRows As Integer
Dim X As Integer


Range("A2").Select
NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
CurItem = ActiveCell.Value
'PromDate = PromDate & ActiveCell.Offset(0, 2).Value & "," & ActiveCell.Offset(0, 3).Value

For X = 1 To NumRows

'    ActiveCell.Offset(1, 0).Select
    
    If ActiveCell.Value = CurItem Then
          PromDate = PromDate & ", " & ActiveCell.Offset(0, 2).Value & ", " & ActiveCell.Offset(0, 3).Value
    ElseIf ActiveCell.Value <> curritem Then
    
            If Len(PromDate) > 0 Then
                PromDate = Right(PromDate, Len(PromDate) - 2)
            End If
            
        ActiveCell.Offset(-1, 4).Value = PromDate
        PromDate = ""
        'CurItem = ActiveCell.Offset(-1, 0).Value
    End If
    
        ActiveCell.Offset(-1, 0).Select

Next X

MsgBox "done"



End Sub

[code]

 

[SkipVought]

Hi,

You've been knocking around Tek-Tips longer than I have.

First off you have a miss-typed variable curritem in the ElseIf statement.

Then in reality the ElseIf is not necessary as it is the Else of your IF statement. So you ought to have...

'
    For X = 1 To NumRows
        
        ' ActiveCell.Offset(1, 0).Select
        
        If ActiveCell.Value = CurItem Then
            PromDate = PromDate & ", " & ActiveCell.Offset(0, 2).Value & ", " & ActiveCell.Offset(0, 3).Value
        Else
            If Len(PromDate) > 0 Then
                PromDate = Right(PromDate, Len(PromDate) - 2)
            End If
            
            ActiveCell.Offset(-1, 4).Value = PromDate
            PromDate = ""
            'CurItem = ActiveCell.Offset(-1, 0).Value
        End If
        
        ActiveCell.Offset(-1, 0).Select
    
    Next X

But beyond that, There are other serious problems with the logic. Perhaps you could explain what it is that you want your code to do.

What should the result be for the first row?

Where should this result be placed?

Will this be repeated for each row?


Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[BeckyMc]

In the fourth column for each part number at the end of the list of items for that part number I want

date , qty , date , qty , date , qty

all as one string

 

[BeckyMc]

Went back to a do until loop but changed the offset that concatenates into the prom date a little. Now I'm missing some dates on the end but at least I'm getting the first date. For a forecast report that first date is crucial. The last date I can fix later. I think I need a loop that does a step feature somewhere.

Sub Button1_Click()


Dim CurItem As String
Dim PromDate As String

Range("A2").Select

CurItem = ActiveCell.Value
'PromDate = PromDate & ActiveCell.Offset(0, 2).Value & "," & ActiveCell.Offset(0, 3).Value

Do Until IsEmpty(ActiveCell)

'    ActiveCell.Offset(1, 0).Select
    
    If ActiveCell.Value = CurItem Then
          PromDate = PromDate & ", " & ActiveCell.Offset(-1, 2).Value & ", " & ActiveCell.Offset(-1, 3).Value
    ElseIf ActiveCell.Value <> curritem Then
    
            If Len(PromDate) > 0 Then
                PromDate = Right(PromDate, Len(PromDate) - 2)
            End If
            
        ActiveCell.Offset(-1, 4).Value = PromDate
        PromDate = ""
        CurItem = ActiveCell.Value
    End If
    
        ActiveCell.Offset(1, 0).Select

Loop

MsgBox "done"
End Sub

[code]

 

[Andrzejek]

Would it be too much to ask to format your data

[pre]
Item Descr Date Qty/Rate
a aaa 7/24/2018 504
a aaa 9/18/2018 504
a aaa 11/2/2018 504
b bbb 7/31/2018 756
b bbb 8/15/2018 168
b bbb 9/21/2018 756
b bbb 10/19/2018 756
b bbb 11/16/2018 756
b bbb 12/14/2018 756
b bbb 2/8/2019 756
c ccc 9/4/2018 100
d d 10/5/2018 200
e e 8/6/2018 12
[/pre]

and your code?


---- Andy

There is a great need for a sarcasm font.

 

[SkipVought]

Sub Button1_Click()
    Dim PromDate As String
    Dim LastRow As Long
    Dim X As Long, Y As Integer
    Dim lRow As Long, lFirstRow As Long
    Dim sPrevItem As String, sThisItem As String
    
    LastRow = Range("A2").End(xlDown).Row
    
    lFirstRow = 2
    For X = 2 To LastRow
        lRow = X
        sThisItem = Cells(lRow, "A").Value
        
        If sPrevItem <> sThisItem Then
            If PromDate <> "" Then
                GoSub WritePromDate
                lFirstRow = lRow
            End If
        End If
        
        For Y = 3 To 4
            PromDate = PromDate & Cells(lRow, Y).Value & ", "
        Next
        
        sPrevItem = sThisItem
    Next X
    
    GoSub WritePromDate
    
    MsgBox "done"
    Exit Sub

WritePromDate:
    PromDate = Left(PromDate, Len(PromDate) - 2)
    Cells(lFirstRow, "E").Value = PromDate
    PromDate = ""
    
    Return
End Sub

[pre]
Item Descr Date Qty/Rate
a aaa 7/24/2018 504 7/24/2018, 504, 9/18/2018, 504, 11/2/2018, 504
a aaa 9/18/2018 504
a aaa 11/2/2018 504
b bbb 7/31/2018 756 7/31/2018, 756, 8/15/2018, 168, 9/21/2018, 756, 10/19/2018, 756, 11/16/2018, 756, 12/14/2018, 756, 2/8/2019, 756
b bbb 8/15/2018 168
b bbb 9/21/2018 756
b bbb 10/19/2018 756
b bbb 11/16/2018 756
b bbb 12/14/2018 756
b bbb 2/8/2019 756
c ccc 9/4/2018 100 9/4/2018, 100
d d 10/5/2018 200 10/5/2018, 200
e e 8/6/2018 12 8/6/2018, 12

[/pre]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[BeckyMc]

I think that does take care of it. Thank you!