asked on

Listview sort and combine

Working with a listview in vb6 and i need to convert the below from BEFORE to AFTER
can't seem to get the logic correct

Before
Time	Appt#	Manifest	DN's	QTY
10:00am	17488	7848	6	36
10:00am	17488	7855	63	378
12:00pm	17470	7853	99	594
12:00pm	17471	7854	99	594
2:00pm	17472	7856	1	1
2:00pm	17472	7856	3	3

After
Time	Appt#	Manifest	DN's	QTY
10:00am	1	7848	6	36
		7855	63	378
12:00pm	2	7853	99	594
12:00pm	3	7854	99	594
2:00pm	4	7856	1	1
	4	7856	3	3

Martin Liss

Please supply a project I can work with.

rjef

ASKER

Martin Liss
did u get my message?

rjef

ASKER

correction
that last line in the 'AFTER' example should have a blank where the '4' is
+

Martin Liss

Put this under a new button. Line 10 sets the sorted property of the Listview to False which is required because of the blanks in the first column.

Private Sub cmdConvert_Click()
Dim lngEntry As Long
Dim strNew() As String
Dim strOldTime As String
Dim strOldAppt As String
Dim itemX As ListItem
Dim intApptNum As Integer

With LVMain3
    .Sorted = False
    
    ReDim strData(LVMain3.ListItems.Count - 1, LVMain3.ColumnHeaders.Count - 1)
    For lngEntry = 0 To LVMain3.ListItems.Count - 1
        strData(lngEntry, 0) = .ListItems(lngEntry + 1)
        strData(lngEntry, 1) = .ListItems(lngEntry + 1).SubItems(1)
        strData(lngEntry, 2) = .ListItems(lngEntry + 1).SubItems(2)
        strData(lngEntry, 3) = .ListItems(lngEntry + 1).SubItems(3)
        strData(lngEntry, 4) = .ListItems(lngEntry + 1).SubItems(4)
    Next
    
    .ListItems.Clear
    For lngEntry = 0 To UBound(strData)
            If strData(lngEntry, 0) = strOldTime And strData(lngEntry, 1) = strOldAppt Then
                Set itmx = .ListItems.Add(, , "")
                itmx.SubItems(1) = ""
            Else
                Set itmx = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmx.SubItems(1) = intApptNum
                strOldTime = strData(lngEntry, 0)
                strOldAppt = strData(lngEntry, 1)
    
            End If
            itmx.SubItems(2) = strData(lngEntry, 2)
            itmx.SubItems(3) = strData(lngEntry, 3)
            itmx.SubItems(4) = strData(lngEntry, 4)
            If lngEntry = 0 Then
                strOldTime = strData(0, 0)
                strOldAppt = strData(0, 1)
            End If
        Next
End With
End Sub

Open in new window

rjef

ASKER

looks great
would it be very complicated to make the manifest column only have 1 manifest when there are 2 of the same?

Martin Liss

Do you mean add up the Manifest, DN's and QTY instead of adding a line with a blank manifest? If so please ask a new question.

rjef

ASKER

no sum, last 2 lines would look like this

Martin Liss

So the only difference is that the manifest is blank? If so

Private Sub cmdConvert_Click()
Dim lngEntry As Long
Dim strNew() As String
Dim strOldTime As String
Dim strOldAppt As String
Dim itemX As ListItem
Dim intApptNum As Integer

With LVMain3
    .Sorted = False
    
    ReDim strData(LVMain3.ListItems.Count - 1, LVMain3.ColumnHeaders.Count - 1)
    For lngEntry = 0 To LVMain3.ListItems.Count - 1
        strData(lngEntry, 0) = .ListItems(lngEntry + 1)
        strData(lngEntry, 1) = .ListItems(lngEntry + 1).SubItems(1)
        strData(lngEntry, 2) = .ListItems(lngEntry + 1).SubItems(2)
        strData(lngEntry, 3) = .ListItems(lngEntry + 1).SubItems(3)
        strData(lngEntry, 4) = .ListItems(lngEntry + 1).SubItems(4)
    Next
    
    .ListItems.Clear
    For lngEntry = 0 To UBound(strData)
            If strData(lngEntry, 0) = strOldTime And strData(lngEntry, 1) = strOldAppt Then
                Set itmx = .ListItems.Add(, , "")
                itmx.SubItems(1) = ""
                itmx.SubItems(2) = ""
            Else
                Set itmx = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmx.SubItems(1) = intApptNum
                itmx.SubItems(2) = strData(lngEntry, 2)
                strOldTime = strData(lngEntry, 0)
                strOldAppt = strData(lngEntry, 1)
            End If
            itmx.SubItems(3) = strData(lngEntry, 3)
            itmx.SubItems(4) = strData(lngEntry, 4)
            If lngEntry = 0 Then
                strOldTime = strData(0, 0)
                strOldAppt = strData(0, 1)
            End If
        Next
End With
End Sub

Open in new window

rjef

ASKER

perfect
thanks
your the best

Martin Liss

Please don't forget to close this question. I also suggest you put Option Explicit at the top of the form's code. It will force you to define all your variables but doing that will help avoid hard to find typo-caused bugs.

rjef

ASKER

Marin Liss
can you look at your message (From me) and let me know if i need to open another ticket?

Martin Liss

Please describe the problem here and attach a csv of the input data.

rjef

ASKER

the 3rd column needs to behave like the first 2. if the value in the next row is equal then remove it, only keep it if it is unique.
Should-be-getting-082020082319.csv

rjef

ASKER

i think i figured it out

Martin Liss

That's better than I've done; I'm still trying:)

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rjef

ASKER

you knew i would. checking your code now

rjef

ASKER

when testing this one i get this result
shouldn't the 2nd 12:00 pm be blank and 3 be listed twice?

Martin Liss

The data I'm using looks like this

and your Should-be-getting-082020082319.csv file contains this.
after,,,,
Time,Appt#,Manifest,DN's,QTY
12:00pm,1,7874,1,111
,,,17,102
,,,59,354
,,7875,4,400
,,,5,500
,,,9,900
,,,9,900
12:00pm,2,7872,21,126
,,,6,36
,,7873,13,65
,,,7,420
,,7878,29,174
,,7879,69,690
2:00pm,3,7868,47,47
My conversion produces this which I think is the same.

rjef

ASKER

can you use
11:00am,17823,7885,43,121
12:00pm,17791,7884,22,11
12:00pm,17791,7882,29,12
2:00pm,17790,7881,51,5

Martin Liss

In addition to what I already have or just those four records?

rjef

ASKER

those 4

rjef

ASKER

ops one more just a sec
here are all 5

11:00am,17823,7885,43,121
11:00am,17823,7894,24,527
12:00pm,17791,7884,22,11
12:00pm,17791,7882,29,12
2:00pm,17790,7881,51,5

Martin Liss

Before:

After:

Should the second 12:00pm be blank?

rjef

ASKER

yes

SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rjef

ASKER

thanks that did it

SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rjef

ASKER

this did not work with these numbers
this does not work with the sort

2:00pm,18092,7934,47,47
11:00am,18188,7944,62,372
11:00am,18190,7945,99,594
11:00am,18188,7945,28,168
1:00pm,18207,7949,100,100
1:00pm,18208,7950,100,100

Martin Liss

Try this. Should the Manifest for Appt 4 be blank?

Private Sub cmdConvert_Click()
Dim lngEntry As Long
Dim strNew() As String
Dim strOldTime As String
Dim strOldAppt As String
Dim strOldManifest As String
Dim itemX As ListItem
Dim intApptNum As Integer

With LVMain3
    .Sorted = False
    
    ReDim strData(LVMain3.ListItems.Count - 1, LVMain3.ColumnHeaders.Count - 1)
    For lngEntry = 0 To LVMain3.ListItems.Count - 1
        strData(lngEntry, 0) = .ListItems(lngEntry + 1)
        strData(lngEntry, 1) = .ListItems(lngEntry + 1).SubItems(1)
        strData(lngEntry, 2) = .ListItems(lngEntry + 1).SubItems(2)
        strData(lngEntry, 3) = .ListItems(lngEntry + 1).SubItems(3)
        strData(lngEntry, 4) = .ListItems(lngEntry + 1).SubItems(4)
    Next
    
    .ListItems.Clear

    ' Subitems
    ' 1: Appt
    ' 2: Manifest
    ' 3: DN's
    ' 4: Qty
    
    For lngEntry = 0 To UBound(strData)
        Select Case True
            Case (strData(lngEntry, 0) <> strOldTime And _
                 strData(lngEntry, 1) <> strOldAppt And _
                 strData(lngEntry, 2) <> strOldManifest)
                ' It's the first record or all the keys have changed
                ' so add all the data and set up the "old" values
                Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldTime = strData(lngEntry, 0)
                strOldAppt = strData(lngEntry, 1)
                strOldManifest = strData(lngEntry, 2)
            Case strData(lngEntry, 1) <> strOldAppt And _
                 strData(lngEntry, 2) <> strOldManifest
                 ' The manifest and appt have changed so add
                 ' the time,appt and manifest, add everything and
                 ' save the manifest and appt
                 'new
'                Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                Set itmX = .ListItems.Add(, , "")

                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldAppt = strData(lngEntry, 1)
                strOldManifest = strData(lngEntry, 2)
            'new
            Case strData(lngEntry, 1) <> strOldAppt
                 ' The appt have changed so add
                 ' the the manifest, add everything and
                 ' save the manifest and appt
                 'new
'                Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                Set itmX = .ListItems.Add(, , "")

                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldAppt = strData(lngEntry, 1)
                strOldManifest = strData(lngEntry, 2)

            Case strData(lngEntry, 0) = strOldTime And _
                 strData(lngEntry, 1) = strOldAppt And _
                 strData(lngEntry, 2) = strOldManifest
                 ' None of the "old" values have changed (time, Appt and Manifest)
                 ' so blank out those 3 and add the DN's and the Qty.
                 ' There's no need to save any "old" value
                Set itmX = .ListItems.Add(, , "")
                itmX.SubItems(1) = ""
                itmX.SubItems(2) = ""
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
            Case strData(lngEntry, 0) = strOldTime And _
                 strData(lngEntry, 1) = strOldAppt
                 ' Just the manifest has changed so blank out
                 ' the time and appt, and add the Manifest, DN's and Qty and
                 ' save the new manifest
                Set itmX = .ListItems.Add(, , "")
                itmX.SubItems(1) = ""
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldManifest = strData(lngEntry, 2)
            Case strData(lngEntry, 0) = strOldTime
                ' Enverything has changed so add and save everything
                 Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldTime = strData(0, 0)
                strOldAppt = strData(0, 1)
                strOldManifest = strData(0, 2)
            Case Else
                ' Only the time is the same so add all the data
                ' and save the appt and manifest
                Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldAppt = strData(0, 1)
                strOldManifest = strData(0, 2)
        End Select
    Next
End With
End Sub

Open in new window

Martin Liss

Please ignore the code above because I decided to rewrite it. Previously my code had been situational. In other words if there this specific situation do this specific thing. The code now is a logical four-step, left to right examination of the data in the rows. It should be easier for someone to understand and change if necessary. The four steps are:

If the time changes show everything.
Otherwise if the appointment (which is the next field to the right) changes blank out the time and show everything else
Otherwise if the manifest changes blank out the time and appointment and show everything else
Otherwise nothing important has changed so blank out the time and appointment and show everything else

While I tested with all the example that I have and it seems to work, you should thoroughly test this since it's a fairly major change.

Private Sub cmdConvert_Click()
Dim lngEntry As Long
Dim strNew() As String
Dim strOldTime As String
Dim strOldAppt As String
Dim strOldManifest As String
Dim itemX As ListItem
Dim intApptNum As Integer

With LVMain3
    .Sorted = False
    
    ReDim strData(LVMain3.ListItems.Count - 1, LVMain3.ColumnHeaders.Count - 1)
    For lngEntry = 0 To LVMain3.ListItems.Count - 1
        strData(lngEntry, 0) = .ListItems(lngEntry + 1)
        strData(lngEntry, 1) = .ListItems(lngEntry + 1).SubItems(1)
        strData(lngEntry, 2) = .ListItems(lngEntry + 1).SubItems(2)
        strData(lngEntry, 3) = .ListItems(lngEntry + 1).SubItems(3)
        strData(lngEntry, 4) = .ListItems(lngEntry + 1).SubItems(4)
    Next
    
    .ListItems.Clear

    ' Subitems
    ' 1: Appt
    ' 2: Manifest
    ' 3: DN's
    ' 4: Qty
    For lngEntry = 0 To UBound(strData)
        Select Case True
            Case strData(lngEntry, 0) <> strOldTime
                ' The time is not equal to the old time so
                ' show everything and save everything
                Set itmX = .ListItems.Add(, , strData(lngEntry, 0))
                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldTime = strData(lngEntry, 0)
                strOldAppt = strData(lngEntry, 1)
                strOldManifest = strData(lngEntry, 2)
            Case strData(lngEntry, 1) <> strOldAppt
                 ' The time is the same but the appt number has changed
                 ' so blank the time, show everything else and save the
                 ' new Appt
                Set itmX = .ListItems.Add(, , "")
                intApptNum = intApptNum + 1
                itmX.SubItems(1) = intApptNum
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldAppt = strData(lngEntry, 1)
            Case strData(lngEntry, 2) <> strOldManifest
                 ' The time and Appt are the same but the manifest
                 ' has changed so blank the time and appt, show everything
                 ' else and save the new manifest
                Set itmX = .ListItems.Add(, , "")
                itmX.SubItems(1) = ""
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
                strOldManifest = strData(lngEntry, 2)
            Case Else
                ' Nothing has changed so blank the time and appt
                ' and show everything else. Nothing needs to be
                ' saved.
                Set itmX = .ListItems.Add(, , "")
                itmX.SubItems(1) = ""
                itmX.SubItems(2) = strData(lngEntry, 2)
                itmX.SubItems(3) = strData(lngEntry, 3)
                itmX.SubItems(4) = strData(lngEntry, 4)
        End Select
    Next
End With
End Sub

Open in new window