Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Determine if values should be read into listview

Status
Not open for further replies.
kalle82

kalle82

Technical User
Apr 2, 2009
163
SE
Hi!

Currently Im using this code to read my excel cell values into my listview control and to change change the color on my listview rows.

Here's my question: How do I design my loop not to add rows when column G has a value?

I have tried with the following code
Code: 
 If lvwItem.SubItems(6) = "" Then
                                
                lvwItem.SubItems(3).Remove (2)
                                    
                End If

But I cannot get it to work? Any tips on this?


Code: 
Dim ws As Worksheet
    Dim lngRow As Long
    Dim lvwItem As ListItem
    Dim lngEndCol As Long
    Dim lngCol As Long
    Dim lngEndRow As Long
    Dim lngItemIndex As Long
    Dim lvwItem2 As ListItem
        
    Set ws = Worksheets("Ärenden")
    lngEndCol = ws.Range("A1:K1").End(xlToRight).Column
    lngEndRow = ws.Range("A1:K1").End(xlDown).Row
    
    lngRow = 1
    With ListView1
        .View = lvwReport
        For lngCol = 1 To lngEndCol
                                
            .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        Next
        For lngRow = 2 To lngEndRow
            lngCol = 1
            lngItemIndex = 0
            Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
            For lngCol = 2 To lngEndCol
                lngItemIndex = lngItemIndex + 1
                
                If lvwItem.SubItems(3) = "21 Försäkringskassan" Then
                
                GoTo apa
                
                Else
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
                
                End If
                
apa:
                
                If lvwItem.SubItems(3) = "22 Kronofogden" Then
                lvwItem.ForeColor = RGB(100, 200, 50)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(100, 200, 50)
                
                ElseIf lvwItem.SubItems(3) = "26 CSN" Then

                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 165, 0)
                
                ElseIf lvwItem.SubItems(3) = "21 Försäkringskassan" Then

                lvwItem.ForeColor = RGB(255, 0, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 0, 0)
                
                End If
            
                
               ' Set lvwItem2 = .ListItems.Remove(lngItemIndex)
                             
               ' .ListItem.Remove(lngItemIndex).Value
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value
                
          
                'End If
            Next
        Next
    End With
 
Sort by date Sort by votes
My first guess is an empty item is null not an empty string. The following tests all cases: Null,space, empty string

If trim(lvwItem.SubItems(6) & " ") =
 
Upvote 0 Downvote
Hi! Thanks for the answer MajP, It helped me through some parts, thansk for your reply. I managed to get the first part right but now i get index out of bounds? How come? Have been trying to solve this for the last couple of hours

Code: 
   With ListView1
        .View = lvwReport
        For lngCol = 1 To lngEndCol
                                
            .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        Next
        
        For lngRow = 2 To lngEndRow
            lngCol = 1
            lngItemIndex = 0
                                    
            Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
            
           
            
            For lngCol = 2 To lngEndCol
                lngItemIndex = lngItemIndex + 1
                
              '  If lvwItem.SubItems(3) = "21 Försäkringskassan" Then
                
              '  GoTo apa
                
             '   Else
                
               '' lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
                
              '  End If
                
'´apa:
               If ListView1.ListItems(lngItemIndex).SubItems(3) = "22 Kronofogden" Then
               ListView1.ListItems.Remove lngItemIndex

                End If
                    
                If lvwItem.SubItems(3) = "22 Kronofogden" Then
                lvwItem.ForeColor = RGB(100, 200, 50)
                lvwItem.ListSubItems.Item(lngItemIndex - 3).ForeColor = RGB(100, 200, 50)
                
                ElseIf lvwItem.SubItems(3) = "26 CSN" Then

                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 165, 0)
                
                ElseIf lvwItem.SubItems(3) = "21 Försäkringskassan" Then

                lvwItem.ForeColor = RGB(255, 0, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 0, 0)
                
                End If
            
                
               ' Set lvwItem2 = .ListItems.Remove(lngItemIndex)
                
                
               ' .ListItem.Remove(lngItemIndex).Value
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value
                        
                
                
                'End If
           
            
            Next
       
        Next
        
    End With
 
Upvote 0 Downvote
the columns and rows are likely zero indexed (I have to double check). So assume you have 4 columns. If lngEndCol = 4 then this fails
For lngCol = 1 To lngEndCol
because the last column is an index of 3 (0,1,2,3)

To error check this I would put in a lot of debug.print statements so I now exactly the index value when I go out of bounds. Repeat these whenever the values change.

debug.print lngEndCol
debug.print lntEndRow
debug.print lngItemIndex
 
Upvote 0 Downvote
Hi! MajP I understand the out of bounds thing ;)

But I dont understand why it tell me it´s out of bounds, fortunately my first four rows goes by with no problem at all. Im stepping through the code with F8, and I keep track of lngItemIndex value, it does increase by one each time the loop finish.

I have debugged it for an hour or two. Seems like the loop goes builds the lngItemIndex to 13, then back to 0. And thats why I get the out of bounds, because the lngItemindex, does not show on what row in the listview we are currently on. lngItemIndex moves from left to right asssigneing subitems.

I tried with a fixed number but then it says I already deleted that control. I can understand that now i need to now on what row i am. Maybe if i put a variable in the top tha increments in my first for loop it will only be incremented when the program goes to a new row.

Let me hear what you think.

EDIT, I made som changes but now it says the items control is deleted..?
Code: 
With ListView1
        .View = lvwReport
        For lngCol = 1 To lngEndCol
                                
            .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        Next
        
        For lngRow = 2 To lngEndRow
            lngCol = 1
            lngItemIndex = 0
                                    
            Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
            Dim n As Integer
            n = n + 1
           
            
            For lngCol = 2 To lngEndCol
                lngItemIndex = lngItemIndex + 1
           
             
              '  If lvwItem.SubItems(3) = "21 Försäkringskassan" Then
                
              '  GoTo apa
                
             '   Else
                
               '' lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
                
              '  End If
                
'´apa:
                
                If lvwItem.SubItems(3) = "22 Kronofogden" Then
                ListView1.ListItems.Remove (n)
                
                GoTo sture

                End If
              
                    
                If lvwItem.SubItems(3) = "26 CSN" Then
                lvwItem.ForeColor = RGB(100, 200, 50)
                lvwItem.ListSubItems.Item(lngItemIndex - 3).ForeColor = RGB(100, 200, 50)
                
                ElseIf lvwItem.SubItems(3) = "26 CSN" Then

                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 165, 0)
                
                ElseIf lvwItem.SubItems(3) = "21 Försäkringskassan" Then

                lvwItem.ForeColor = RGB(255, 0, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 0, 0)
                
                End If
            
                
               ' Set lvwItem2 = .ListItems.Remove(lngItemIndex)
                
                
               ' .ListItem.Remove(lngItemIndex).Value
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value
                       
               
sture:
                
                'End If
           
            
            Next
       
        Next
        
    End With
 
Upvote 0 Downvote
Got it working, but now theres another problem???!!!

So when I run my IF STATEMENT

Code: 
 If Trim(lvwItem.SubItems(6) & "") = "" Then
                ListView1.ListItems.Remove (n)
                
                lngCol = 11
                n = n - 1
                GoTo sture

                End If

They code runs like this
row 1, then takes all 11 columns then adds them to listview
and then goes to row 2. What that means is that the loop runs 11 times to complete one row, then it moves on to the next row.

The problem is that when using lvwItem.Subitem(6), it will be empty the first 5 runs, cause it does not yet know the value of subitem(6) therefore its empty? And thats when the problem gets alot worse.. everytime its empty it deletes the row and moves on to the next so i have a working if statment but all it does it deleting every row...

HERES THE QUESTION
How can i construct this to wait until we get the real value of subitem(6) before deleting the row..?


Code: 
Dim ws As Worksheet
    Dim lngRow As Long
    Dim lvwItem As ListItem
    Dim lngEndCol As Long
    Dim lngCol As Long
    Dim lngEndRow As Long
    Dim lngItemIndex As Long
    Dim lvwItem2 As ListItem
    
    ' Sätter det som ska läsas in
        
    Set ws = Worksheets("Ärenden")
    lngEndCol = ws.Range("A1:K1").End(xlToRight).Column
    lngEndRow = ws.Range("A1:K1").End(xlDown).Row
    
    lngRow = 1
    With ListView1
        .View = lvwReport
        For lngCol = 1 To lngEndCol
                                
            .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        Next
        
        For lngRow = 2 To lngEndRow
            lngCol = 1
            lngItemIndex = 0
                                    
            Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
            Dim n As Integer
           n = n + 1
           
            
            For lngCol = 2 To lngEndCol
                lngItemIndex = lngItemIndex + 1
           
             
              '  If lvwItem.SubItems(3) = "21 Försäkringskassan" Then
                
                 'GoTo apa
                
             '   Else
                
               '' lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
                
              '  End If
                
'´apa:
                
                If Trim(lvwItem.SubItems(6) & "") = "" Then
                ListView1.ListItems.Remove (n)
                
                lngCol = 11
                n = n - 1
                GoTo sture

                End If
              
                    
                If lvwItem.SubItems(3) = "26 CSN" Then
                lvwItem.ForeColor = RGB(100, 200, 50)
                lvwItem.ListSubItems.Item(lngItemIndex - 3).ForeColor = RGB(100, 200, 50)
                
                ElseIf lvwItem.SubItems(3) = "26 CSN" Then

                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 165, 0)
                
                ElseIf lvwItem.SubItems(3) = "21 Försäkringskassan" Then

                lvwItem.ForeColor = RGB(255, 0, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 2).ForeColor = RGB(255, 0, 0)
                
                End If
            
                
               ' Set lvwItem2 = .ListItems.Remove(lngItemIndex)
                
                
               ' .ListItem.Remove(lngItemIndex).Value
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value
                       
               
sture:
                
                'End If
           
            
            Next
       
        Next
        
    End With
 
Upvote 0 Downvote
Got that working too!

Code: 
If lvwItem.SubItems(6) = "" Then
                
                
                Else
                
                
                ListView1.ListItems.Remove (n)
                
                lngCol = 11
                n = n - 1
                GoTo sture

                End If
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
863
strongm
strongm
remeng
  • Locked
  • Question
If obsolete - deactivate all but one macro
Replies
6
Views
375
mintjulep
M
kris gersbach
  • Locked
  • Question
I’m importing a csv into a vfp curs
Replies
1
Views
237
Andrzejek
Andrzejek
Andrzejek
  • Question
Open Word as ReadOnly 1
Replies
4
Views
211
Andrzejek
Andrzejek
telephoto
  • Locked
  • Question
If...Then routine not recognised when it should be 1
Replies
12
Views
315
SkipVought
S

Part and Inventory Search

Sponsor

Back
Top