We help IT Professionals succeed at work.
Troubleshooting Question

Listview sort and combine

rjef
rjef asked
on
84 Views
Last Modified: 2020-09-11
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



TimeAppt#ManifestDN'sQTY
10:00am174887848636
10:00am17488785563378
12:00pm17470785399594
12:00pm17471785499594
2:00pm17472785611
2:00pm17472785633





After



TimeAppt#ManifestDN'sQTY
10:00am17848636


785563378
12:00pm2785399594
12:00pm3785499594
2:00pm4785611

4785633

Comment
Watch Question

Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Please supply a project I can work with.

Author

Commented:
Martin Liss
did u get my message?

Author

Commented:
correction
that last line in the 'AFTER' example should have a blank where the '4' is
+
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

Commented:
looks great
would it be very complicated to make the manifest column only have 1 manifest when there are 2 of the same?
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.

Author

Commented:
no sum, last 2 lines would look like this


last 2 rows
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

Commented:
perfect
thanks
your the best
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.

Author

Commented:
Marin Liss
can you look at your message (From me) and let me know if i need to open another ticket?
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

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

Author

Commented:
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

Author

Commented:
i think i figured it out
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
That's better than I've done; I'm still trying:)
Protect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

Commented:
you knew i would.  checking your code now

Author

Commented:
when testing this one i get this result
shouldn't the 2nd 12:00 pm be blank and 3 be listed twice?
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.

Author

Commented:
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 LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

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

Author

Commented:
those 4

Author

Commented:
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 LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Before:
2020-08-31_11-34-45.pngAfter:
2020-08-31_11-35-21.png
Should the second 12:00pm be blank?

Author

Commented:
yes
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

Commented:
thanks that did it
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

Commented:
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 LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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 LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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:
  1. If the time changes show everything.
  2. Otherwise if the appointment (which is the next field to the right) changes blank out the time and show everything else
  3. Otherwise if the manifest changes blank out the time and appointment and show everything else
  4. 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

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions