Results 1 to 15 of 15
  1. #1
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts

    Question Macro to list items from range is skipping columns

    Hi,

    I'm no macro wiz, can sort of figure out what's going on, maybe, with lots of googling

    So I had someone - a few years ago - create a macro for me. It's been working fine - but recently discovered an issue.

    Purpose of ss: Registration for an event. On registration, participants can choose a tshirt - or several.
    Registration web form populates flat file db, that's pulled into prepared spreadsheet. Each tshirt option is a column, but there's lots of choises, so the macro reads across and summarizes all of the tshirts into one column, e.g. 1 - XXL-Tshirt-Cotton-Black in a cell.

    However, if they have chosen tshirts that are in three or more consecutive columns - rare which is why only just discovered the issue - then only the first and last are summarized.

    Sample spreadsheet attached, but to start:

    Relevant Column names:
    A..............B..........C........D........E..... ..........F...........G.........loads of columns...........EW................EX............ ..........EY etc...
    RallyType D / M / Y H:M email emailcheck firstname lastname ...loads of columns... TshirtSummary S-Tshirt-Cotton-Grey M-Tshirt-Cotton-Grey and more....

    Macro: (I've added a number of comments as I've worked out what's going on trying to debug, and as I've made changes to the spreadsheet as it's grown and expanded over the years)

    Code:
    Sub TShirt_Summary()
    
    ' TShirt_Summary Macro
    ' Summarizes T-shirt info into column X for every row containing a first name entry up to the row labelled "Cancellations"
    ' NOTES:
    ' 1: there must be a row, with Name: "Cancellations" which is the signal to stop processing.
    ' 2: Range G2 and offset : 6 = -1 from left that G is?!
    ' 3: Note there are TWO locations (plus the comment) for the number of columns tshirt summary is from firstname - get them both!
    
    ' BUG in this code - IF there are several t-shirts chosen, in 3 or more CONSECUTIVE columns, only the first and last will be found,
    ' the rest missed. (This has been there since the beginning, old versions same)
    
    Dim Cancel As Range, List As Range
    Dim Quantity As Range, Summary As String, Shirt As String
        
        Set Cancel = ThisWorkbook.Names("Cancellations").RefersToRange   'Identifies row below the last entry
        Set List = Range("G4", Cancel.Offset(-1, 6))                     'Range: G4 identifies the first "first name", Cancel.offset() = this row, and positions the summary print - unknown how!
                                                                        
        For Each cell In List
            Summary = ""
            If cell.Value = "" Then GoTo done
            If cell.Value = "firstname" Then
                Summary = "TshirtSummary"                                'otherwise it will be deleted
                GoTo done
            End If
            Set Quantity = Range(cell.Offset(0, 146).Address).End(xlToRight)    '147 columns left is column x, "firstname" which is either blank or not
            Shirt = Cells(3, Quantity.Column).Value                             ' Cells(3 = number is the row the tshirt description is in
            If InStr(1, Shirt, "Tshirt") Then                                   'Check it's actually a shirt
            'If (InStr(1, Shirt, "Tshirt") or InStr(1, Shirt, "Fleece") Then     Will probably work - no promises - Doesn't!
                Summary = "" & Quantity.Value & " - " & Shirt
            End If
            While InStr(1, Shirt, "Tshirt")                                     'Stops looking once it runs out of tshirts AND: InStr(3 = number is the row the tshirt description is in
            'While (InStr(1, Shirt, "Tshirt") or (InStr(1, Shirt, "Fleece"))     Will probably work - no promises
                Set Quantity = Quantity.End(xlToRight)
                Shirt = Cells(3, Quantity.Column).Value
                If InStr(1, Shirt, "Tshirt") Then                               'Check it's actually a shirt
                'If (InStr(1, Shirt, "Tshirt") or InStr(1, Shirt, "Fleece") Then     Will probably work - no promises
                    Summary = Summary & Chr(10) & "" & Quantity.Value & " - " & Shirt 'Concatenates the next shirt
                End If
            Wend
    done:       Range(cell.Offset(0, 146).Address) = Summary              '0, = this row, 146 = column to print in
        Next cell
        
    End Sub
    Also, the lines like this: 'While (InStr(1, Shirt, "Tshirt") or (InStr(1, Shirt, "Fleece")) Will probably work - no promises
    does NOT work if I swap out the lines involved. Would be nice if it did, as we would like to add some other options!

    If anyone can help debug this I'd be hugely grateful!

    thanks, Grant
    Attached Files Attached Files
    Last edited by RetiredGeek; 2014-07-12 at 21:43. Reason: Added code tags

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Grant,

    I tackled the problem by starting fresh. I assumed you were trying to break down the values in Col EW across Cols EX:GT. If that is correct here is code that may be much easier to understand and as far as I can tell works on the sample data.
    Code:
    Option Explicit
    
    Sub Test()
    
       Dim varShirts As Variant
       Dim varOrder  As Variant
       Dim icntr     As Long
       Dim iSizeType As Long
       Dim zDelim    As String
      
       Application.ScreenUpdating = False
       zDelim = Chr(10)
       [EW4].Select
       
       Do
         varShirts = Split(ActiveCell.Value, zDelim)
       
         For icntr = 0 To UBound(varShirts)
            varOrder = Split(varShirts(icntr), " ")
            iSizeType = WorksheetFunction.Match(varOrder(2), Range("SizeTypes"), 0)
            '*** Note I named the range EX3:GT3 as SizeTypes used above! ***
            ActiveCell.Offset(0, iSizeType).Value = varOrder(0)
         Next icntr
       
         ActiveCell.Offset(1, 0).Select
         
       Loop Until ActiveCell.Value = ""
       
    End Sub
    Note: this code could be made more efficient by removing the Select statements and using loops and offsets to execute the code but if a little inefficiency doesn't bother you this should meet your needs.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Wow that was quick! Thanks for the ideas, but sorry, it doesn't work for me.

    Maybe I wasn't clear - the contents of EW column are the RESULT of the macro, which reads EX4 and all the numbers in the columns up to GT9 or as many rows as there are. I should have left the results of the macro out, so you could see what was supposed to happen.

    OR, perhaps I messed up when I added the macro to my copy. I just opened the macro, pasted your code in, and renamed your "test()" to the same as mine. Deleted the RESULTS in EW, ran the macro, and nothing.

    thanks, Grant

  4. #4
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    I did add the named range too, for EX3 to GT3, no joy.

  5. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 651 Times in 593 Posts
    Grant,

    See if this solves your problem:

    Code:
    Sub TShirt_Summary()
    Application.ScreenUpdating = False
    '-----------------------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim Cancel As Range, List As Range
    Dim Summary As String, cell As Range
    Dim Shirt As Range, Description As Range
    Set Cancel = ThisWorkbook.Names("Cancellations").RefersToRange   'IDENTIFIES ROW BENEATH LAST ENTRY
    Set List = Range("G4", Cancel.Offset(-1, 6)) 'CANCEL.OFFSET() IDENTIFIES LAST POSSIBLE FIRST NAME IN COL G
    '-----------------------------------------------------------
    'CYCLE THROUGH ROWS
    For Each cell In List
        Summary = ""
        If cell <> "" Then
            Set Description = Range(Cells(cell.Row, 154), Cells(cell.Row, 202)) 'SET RANGE OF TSHIRTS (EX TO GT) ON CURRENT ROW
    '-----------------------------------------------------------
    'CYCLE THROUGH TYPES OF TSHIRTS
            For Each Shirt In Description
                If Shirt <> "" And InStr(1, Cells(3, Shirt.Column), "Tshirt") Or InStr(1, Cells(3, Shirt.Column), "Fleece") Then
                    If Summary = "" Then
                        Summary = Shirt & " - " & Cells(3, Shirt.Column)
                    Else:
                        Summary = Summary & Chr(10) & Shirt & " - " & Cells(3, Shirt.Column)
                    End If
                End If
            Next Shirt
        End If
    Cells(cell.Row, 153) = Summary
    Next cell
    '-----------------------------------------------------------
    Application.ScreenUpdating = True
    End Sub

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Grant,

    Sorry for the confusion. That's what happens when you're old and tired.

    Try this to make it work the other (RIGHT) way.

    Code:
    Sub Test()
    
        Dim lCol  As Long
        Dim lCnt  As Long
        Dim zSummary As String
        
        [EW4].Select
        lCnt = Range("ShirtList").Count  '** Defined Range Name EX3:GT3
        Application.ScreenUpdating = False
        
        Do
        
          With ActiveCell
          
            zSummary = ""
          
            For lCol = 1 To lCnt
               If .Offset(0, lCol).Value <> "" Then
                 zSummary = zSummary & Format(.Offset(0, lCol)) & " - " & _
                            WorksheetFunction.Index(Range("ShirtList"), lCol) & Chr(10)
               End If
            Next lCol
          
            zSummary = Left(zSummary, Len(zSummary) - 1) 'Strip trailing Chr(10)
          
            .Value = zSummary
          
            .Offset(1, 0).Select
          End With  'Activecell
          
         Loop Until Cells(ActiveCell.Row, 1).Value = "" '*** Had to test col that is always used!
        
    End Sub   'Test()
    NOTE: I changed the Range name from SizeTypes to ShirtList in this code as it seemed more appropriate. You can change it back in the code if you don't want to create the new name.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. #7
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    RetiredGeek,

    Absolutely fantastic! Works perfectly, and easy to change the rows if we adjust the sheet - which we will do for next year! And adding in different clothing types works great too.

    Now to add the macro to all 22 spreadsheets we use it on!

    I decided to change the ShirtList range to EX3:GT3 so I didn't have to define a range on all 22 sheets.

    Thanks VERY much, your efforts are hugely appreciated.

    cheers, Grant
    Last edited by GrantHorizons; 2014-07-13 at 14:27.

  8. #8
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Maudibe,

    Thanks for the try! Unfortunately it added the contents of EX4 to every row in EW for some reason. On the first one, where it belonged as there was a 1 in EX4, it entered the quantity, on the others it showed " - S-Fleece-Grey" without the quantity. If I removed the 1 in EX4, it showed " - S-Fleece-Grey" on ALL EW rows.

    thanks, Grant

  9. #9
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Oops.

    RetiredGeek,

    It worked fine on the sample data, but in the real world I got a

    Run-time error '5':
    Invalid procedure call or argument.

    That happened as soon as it hit a row with no tshirts ordered.

    Debug showed line : zSummary = Left(zSummary, Len(zSummary) - 1) 'Strip trailing Chr(10)

    Also:

    It needs to skip over rows with nothing in First Name, and keep going until it hits Cancellations in Column A.

    for testing, duplicate row 3 several times, as each "row 3" is a new category of attendee. Didn't occur to me that would be an issue, as the previous didn't care, just kept going until Cancellations in Column A.

    Note we also don't want everything in EXrow:GTrow to be pasted into EW! (which happens with Maudibe's solution)

    See the capture for clarification:

    Capture.JPG


    thanks, Grant

  10. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Grant,

    Ok here's the modified code.

    Code:
    Sub Test()
    
        Dim lCol  As Long
        Dim lCnt  As Long
        Dim zSummary As String
        
        [EW4].Select
        lCnt = Range("ShirtList").Count  '** Defined Range Name EX3:GT3
        Application.ScreenUpdating = False
        
        Do
        
          With ActiveCell
          
            zSummary = ""
            
            If Cells(.Row, 7).Value = "" Then
              '*** Skip if Col G (firstname) is blank ***
            Else
              For lCol = 1 To lCnt
                 If .Offset(0, lCol).Value <> "" Then
                   zSummary = zSummary & Format(.Offset(0, lCol)) & " - " & _
                              WorksheetFunction.Index(Range("ShirtList"), lCol) & Chr(10)
                 End If
              Next lCol
          
              zSummary = Left(zSummary, Len(zSummary) - 1) 'Strip trailing Chr(10)
          
              .Value = zSummary
            End If
            
            .Offset(1, 0).Select
            
          End With  'Activecell
          
         Loop Until UCase(Cells(ActiveCell.Row, 1).Value) = "CANCELLATIONS"
        
    End Sub   'Test()
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  11. #11
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Sorry, still stops when it hits a row where someone hasn't ordered a tshirt.

    And it reads the content of the next tshirt listing row into EW in that row. Sorry to be so picky!

    thanks, Grant

  12. #12
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    More complete spreadsheet to illustrate the problems with people not necessarily ordering tshirts, and different categories.

    thanks, Grant
    Attached Files Attached Files

  13. #13
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Grant,

    Ok this code will do what you've asked for so far!
    It's important to provide as much detail as possible when asking for code as we can't program what we are unaware of.

    Code:
    Sub Tshirt_Summary()
    
        Dim lCol  As Long
        Dim lCnt  As Long
        Dim zSummary As String
        
        [EW4].Select
        lCnt = Range("EX3:GT3").Count  '** Defined Range Name EX3:GT3
        Application.ScreenUpdating = False
        
        Do
        
          With ActiveCell
          
            zSummary = ""
            
            If Cells(.Row, 7).Value = "" Or _
               UCase(Cells(.Row, 7).Value) = "FIRSTNAME" Then
              '*** Skip if Col G (firstname) is blank ***
            Else
              For lCol = 1 To lCnt
                 If .Offset(0, lCol).Value <> "" Then
                   zSummary = zSummary & Format(.Offset(0, lCol)) & " - " & _
                              WorksheetFunction.Index(Range("EX3:GT3"), lCol) & Chr(10)
                 End If
              Next lCol
          
              If Len(zSummary) > 0 Then
                 .Value = Left(zSummary, Len(zSummary) - 1) 'Strip trailing Chr(10)
              Else
               .Value = ""
              End If
              
            End If
            
            .Offset(1, 0).Select
            
          End With  'Activecell
          
         Loop Until UCase(Cells(ActiveCell.Row, 1).Value) = "CANCELLATIONS"
        
    End Sub   'Tshirt_Summary()
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  14. #14
    Lounger
    Join Date
    Mar 2007
    Location
    Canada
    Posts
    32
    Thanks
    8
    Thanked 0 Times in 0 Posts
    that's got it!

    Sorry about incomplete details, blushing.gif sometimes you forget what is important - it seems obvious, but of course it's not...

    thanks for your help - and patience!

    Grant

  15. #15
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Grant,

    You're welcome...glad we got it sorted.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  16. The Following User Says Thank You to RetiredGeek For This Useful Post:

    GrantHorizons (2015-03-04)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •