Results 1 to 3 of 3

Meet Combination Criteria and dump data accordingly

Threaded View

  1. #1
    Registered User
    Join Date
    08-18-2010
    Location
    tennessee
    MS-Off Ver
    Excel 2003
    Posts
    10

    Meet Combination Criteria and dump data accordingly

    COMBINATION MATCH TO CRITERIA AND DUMP IN SECTIONED OFF ROWS.

    PLEASE SEE ATTACHED SPREAD SHEET AND CODE

    I need it to go down each row if C2 matches C1 and O2 matches O1 copy the entire row.....Continue this untill it gathers 6 matched rows. Once it gathers 6 matched rows then dump it in sheet 3.

    Sheet3 contains marked off locations for 6 matches to be associated togeather. The kicker is I do not want anything in rows that are spaced apart with blue fill.

    I have gotten my code to accomplish the first round...it clears the array but does not skip 1 row (sectioned off by blue fill) and continue to dump. Can anyone help with this PLEASE!!!


    Sub STcombo()

    On Error Resume Next

    Dim row As Integer
    Const cols = 16
    Dim Combo(50, cols) As Variant
    Dim ComboMatch() As Variant
    Dim colm As Integer
    Dim Batchsize As Integer
    Dim count As Integer
    lastrow = 50
    lastcol = 16
    Dim ComboCount As Integer

    Sheets("sheet1").Select

    Range("a1").Select

    For i = 0 To lastrow

    Combo(i, 1) = ActiveCell.Offset(i, 0).Value 'Item No.
    Combo(i, 2) = ActiveCell.Offset(i, 1).Value 'Item Description
    Combo(i, 3) = ActiveCell.Offset(i, 2).Value 'Quantity
    Combo(i, 4) = ActiveCell.Offset(i, 3).Value 'Job No.
    Combo(i, 5) = ActiveCell.Offset(i, 4).Value 'Die No.
    Combo(i, 6) = ActiveCell.Offset(i, 5).Value '# UP
    Combo(i, 7) = ActiveCell.Offset(i, 6).Value '# Colors
    Combo(i, 8) = ActiveCell.Offset(i, 7).Value 'Color 1
    Combo(i, 9) = ActiveCell.Offset(i, 8).Value 'Color 2
    Combo(i, 10) = ActiveCell.Offset(i, 9).Value 'Color 3
    Combo(i, 11) = ActiveCell.Offset(i, 10).Value 'Color 4
    Combo(i, 12) = ActiveCell.Offset(i, 11).Value 'Color 5
    Combo(i, 13) = ActiveCell.Offset(i, 12).Value 'Color 6
    Combo(i, 14) = ActiveCell.Offset(i, 13).Value 'Color 7
    Combo(i, 15) = ActiveCell.Offset(i, 14).Value
    Combo(i, 16) = ActiveCell.Offset(i, 15).Value
    'Column 15 is used later to mark a row when it is used in a combo
    Next i


    For i = 1 To lastrow
    If Combo(i, 16) = "" Then 'use for match first line
    Combo(i, 16) = Combo(i, 3) ' use for match first line
    ComboCount = 1

    For x = i + 1 To lastrow


    If Combo(i, 15) = Combo(x, 15) And Combo(i, 3) = Combo(x, 3) Then ' this works
    Combo(x, 16) = Combo(i, 3) 'And ComboCount = ComboCount + 1 'this works

    End If
    Next x
    End If
    Next i

    ReDim ComboMatch(6, 16) 'Clears initial list

    For a = 0 To lastrow
    For b = 0 To cols


    ComboMatch(a, b) = Combo(a, b)

    Next b

    'For c = a + 1 To lastrow
    If a = 6 Then 'array is full write combo to sheet.

    Sheets("sheet3").Range("a2:p7").Value = ComboMatch 'Pastes data from array to spreadsheet.

    ReDim ComboMatch(6, 16) 'Clears the list
    End If
    Next a
    'End If
    Attached Files Attached Files
    Last edited by chrismartinpetty; 08-24-2011 at 04:51 PM. Reason: didnt get everything

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1