Results 1 to 3 of 3

Thread: Copy rows to 2 sheets using criteria

  1. #1

    Copy rows to 2 sheets using criteria



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I copy data to the sheet "3" in a daily basis so the row count vary every day
    depending on the date range I need. I need only the data in the rows with green
    headings from sheet "3" to go the corresponding headings in sheets "1" and "2"
    with the following criteria:

    I need all of the rows with green headings
    from sheet "3" with the word criteria "Asset" from column "BJ" copyied to the
    green section of sheet "1" after clicking a button called run in sheet "1".
    I
    also need all of the rows with green headings from sheet "3" with the word
    "criteria "Stock" from column "BJ"copyied to the green section of sheet "2"
    after clicking a button called run in sheet "2".

    I need the macro to also
    keep the two rows of space between the green and yellow sections in sheets "1"
    and "2" regardless of how many data it is copyied to the green section. In other
    words I would like it if the green section autosizes so that there is always a
    2-row space between the green and yellow section after the data is pasted in
    sheets "1" and "2".

    Thank you for your time and I would really appreciate
    some assistance with this Macro.

    Attached is the excel
    file.

    Thanks,

    moroformat
    Attached Files Attached Files

  2. #2
    Acolyte gsnidow's Avatar
    Join Date
    Aug 2011
    Location
    Virginia
    Posts
    38
    Articles
    0
    moroformat, I did not see this until just before I had to leave, but I know how it is when you are in a jam, and don't know where to start. Anyhow, here is an extremely brutish, uncommented, not exactly working place for you to start. Make a copy of your workbook first then test on that. You'll be able to see that it is hard-coded to work on sheet "1" and "Asset", but if I have time tomorrow, I'll work on it a bit more. This ought to help you get started.

    Code:
    Sub MoveData()
        Dim arToCols(1 To 2, 1 To 12)
        Dim arFromCols(1 To 2, 1 To 12)
        Dim i As Long, j As Long, y As Long, LastRow As Long, lSkip As Long
        Dim WSTo As Worksheet
        Dim WSFrom As Worksheet
        
        Set WSFrom = ActiveWorkbook.Sheets("3")
        Set WSTo = ActiveWorkbook.ActiveSheet
        With WSTo
            For i = 1 To 12 Step 1
                arToCols(1, i) = i
                arToCols(2, i) = .Cells(8, i).Value
            Next i
        End With
        
        With WSFrom
            LastRow = .Cells(65000, 1).End(xlUp).Row
            y = 1
            For i = 1 To 100 Step 1
                For j = 1 To 12 Step 1
                    If .Cells(1, i).Value = arToCols(2, j) Then
                        arFromCols(1, y) = i
                        arFromCols(2, y) = .Cells(1, i).Value
                        y = y + 1
                    End If
                Next j
            Next i
        End With
        
        With WSTo
            lSkip = 0
            For i = 9 To 9 + LastRow Step 1
                If WSFrom.Cells(i - 8, 62).Value = "Asset" Then
                    For y = 1 To 12 Step 1
                        For j = 1 To 12 Step 1
                            If .Cells(8, y).Value = arFromCols(2, j) Then
                                .Cells(i - lSkip, y).Value = WSFrom.Cells(i - 7, arFromCols(1, j))
                            End If
                        Next j
                    Next y
                Else: lSkip = lSkip + 1
                End If
            Next i
        End With
        
    End Sub

  3. #3
    Acolyte gsnidow's Avatar
    Join Date
    Aug 2011
    Location
    Virginia
    Posts
    38
    Articles
    0
    moroformat, I had a little time this morning, so I went ahead and made this work. Please ignore my previous post. Before you use this, a couple of caveats. You need to make sure all the column headings on sheet "3" *exactly* match the column headings on sheets "1" and "2". The reason is that the code looks for matches, and "NAICS" is not the same as "NAICS " (with a space). I think I had to fix one or two. Secondly, the code assumes there will *always* be *exactly* 8 blank green rows on sheets "1" and "2". If there are more data rows than there are blank target rows, the code will insert enough, and leave your two blank rows between the data and the analysis section. Once again, this is very much a brute force method, as it uses several nested loops to traverse a couple of arrays to get the job done. If you have a large amount of data, it may take a few seconds to run. Maybe someone else will provide a more elegant solution, but until/unless they do, you can try this. There is no error checking, so you can play around with it. Let us know if you encounter any bugs, or need help tweaking it.

    Code:
    Option Explicit
    Sub MoveData()
        Dim arToCols()
        Dim arFromCols()
        Dim i As Long, j As Long, y As Long, LastRow As Long, lSkip As Long, lRowCount As Long
        Dim WSTo As Worksheet
        Dim WSFrom As Worksheet
        Dim strFilter As String
        Dim rng As Range
        Dim c As Variant
        
        ' Set the worksheet objects
        Set WSFrom = ActiveWorkbook.Sheets("3")
        Set WSTo = ActiveWorkbook.ActiveSheet
        
        ' Set our filter, so we can run the same code on either sheet
        Select Case ActiveSheet.Name
            Case "1"
                strFilter = "Asset"
            Case "2"
                strFilter = "Stock"
        End Select
        
        ' Load up the arToCols() array with the column headers we need
        With WSTo
            For i = 1 To 12 Step 1
                ReDim Preserve arToCols(1 To 2, 1 To i)
                arToCols(1, i) = i
                arToCols(2, i) = .Cells(8, i).Value
            Next i
        End With
        
        ' Load up the arFromCols() array with the matching column headings, and also their
        ' column number on sheet 3
        With WSFrom
            ' Set the last row in sheet "3".  We will need this a couple of times
            LastRow = .Cells(65000, 1).End(xlUp).Row
            y = 1
            For i = 1 To 100 Step 1
                If Len("" & .Cells(1, i)) > 0 Then
                    For j = 1 To 12 Step 1
                        If .Cells(1, i).Value = arToCols(2, j) Then
                            ReDim Preserve arFromCols(1 To 2, 1 To i)
                            arFromCols(1, y) = i
                            arFromCols(2, y) = .Cells(1, i).Value
                            y = y + 1
                        End If
                    Next j
                Else
                    Exit For
                End If
            Next i
        End With
        
        ' Determine how many rows of data we have for the current filter type
        ' We will use this number to determine if we need to insert rows on
        ' the active sheet
        With WSFrom
            Set rng = .Range(.Cells(2, 62), .Cells(LastRow, 62))
            lRowCount = 0
            For Each c In rng
                If c.Value = strFilter Then
                    lRowCount = lRowCount + 1
                End If
            Next c
        End With
        
        ' If lRowCount > 8, we know we need to insert some rows.
        With WSTo
            If lRowCount > 1 Then
                For i = 1 To lRowCount - 8
                    .Rows("16:16").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Next i
            End If
        End With
        
        ' Now, populate the data.  Basically here we are traversing the data on sheet "3" first,
        With WSTo
            lSkip = 0
            For i = 2 To LastRow Step 1
                ' This step looks for the filter in column 62
                If WSFrom.Cells(i, 62) = strFilter Then
                    ' If we found the filter, then traverse both arrays to find a match
                    ' on the column headings
                    For y = 1 To 12 Step 1
                        For j = 1 To 12 Step 1
                            ' Once we match the column headings, populate the correct column on the
                            ' active sheet with the data from sheet "3".  Remember, we know which
                            ' column contains the data we need for each column, and it is stored
                            ' in arFromCols()
                            If .Cells(8, y).Value = arFromCols(2, j) Then
                                .Cells(7 + i - lSkip, y).Value = WSFrom.Cells(i, arFromCols(1, j))
                            End If
                        Next j
                    Next y
                Else: lSkip = lSkip + 1
                End If
            Next i
        End With
       
    End Sub

    Greg

Posting Permissions

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