Macro to Copy Data and Paste Values Based on cell criteria

**Taislin** · 11-16-2012, 05:14 PM

Hi again. I´m developping a tool to create a quick report based on Result Tables distributed on Days Sheets. Basically i want that if i select the DAY i want (in MENU) and next i select the MARKET i want, when i press go the macro goes to the selected sheet and selected MARKET range and copies only the values that are not blanck and then parte the same values in a specific range on sheet reports. In the attachement example, there is a MENU. In Menu we select the DAY we want (DAY1, DAY2 or DAY3). Then select the MARKET we want (Football, Basket or Horses). Then we press GO. Based on cells selection, the macro will go to the selected day and market and copy only the range where there are non blanck cells in that specific market, and then paste them (as values) in report sheet on cell C17. Is this possible?

**tigeravatar** · 11-16-2012, 05:58 PM

Taislin,

Attached is a modified version of your posted workbook.
First, I had to get rid of all of the merged cells. They are a nightmare to work with, and it is quite easy to get the effect without actually using merged cells. You can select the "merge area" and right-click -> alignment -> for Horizontal select "Center Across Selection" -> OK

So, now that there are no longer merged cells to deal with, the code is pretty straightfoward. I assigned the below code to the Go "button" on the 'Menu' sheet:

Sub Go_Click()
    
    Dim rngCopy As Range
    Dim strDay As String
    Dim strMkt As String
    
    If Len(Range("C7").Value) = 0 Then
        Range("C7").MergeArea.Select
        MsgBox "Must select the DAY you want", , "Missing Day"
        Exit Sub
    Else
        strDay = Range("C7").Value
    End If
    
    If Len(Range("F7").Value) = 0 Then
        Range("F7").MergeArea.Select
        MsgBox "Must selec tthe MARKET you want", , "Missing Market"
        Exit Sub
    Else
        strMkt = Range("F7").Value
    End If
    
    Application.ScreenUpdating = False
    With Sheets(strDay)
        Set rngCopy = .Rows(1).Find(strMkt).Resize(, 5)
        Set rngCopy = Range(rngCopy, .Cells(.Rows.Count, rngCopy.Column).End(xlUp))
    End With
    
    With Sheets("REPORT")
        .Range("C17:G" & Rows.Count).Clear
        rngCopy.Copy
        With .Range("C17")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
        .Select
        .Range("C17").End(xlDown).Offset(1).Select
    End With
    Application.ScreenUpdating = True
    
End Sub

[EDIT]:
Also, you had a typo on your market drop-down selection. It needed to be "FOOTBALL - MATCH ODDS" but you had "FOOTBALL -MATCH ODDS" (it was missing a space after the dash). Made that quick change and it worked just fine for that market.

**Taislin** · 11-16-2012, 06:13 PM

Thank you for your adjustments. Its perfect. Didnt know that merged cells wore so hard to work with. Thank you.

**Taislin** · 11-16-2012, 06:23 PM

Sorry. Just a quick question: if i want the macro only get data starting on B14 (for market football) and for the other markets the same what shoul i change on macro? Basically i wnat it only puts on Reports the data entered and not all the other stuff.

**tigeravatar** · 11-16-2012, 06:47 PM

Without all the other stuff, the Report page will look a bit empty, but here you go:

Sub Go_Click()
    
    Dim rngCopy As Range
    Dim strDay As String
    Dim strMkt As String
    
    If Len(Range("C7").Value) = 0 Then
        Range("C7").MergeArea.Select
        MsgBox "Must select the DAY you want", , "Missing Day"
        Exit Sub
    Else
        strDay = Range("C7").Value
    End If
    
    If Len(Range("F7").Value) = 0 Then
        Range("F7").MergeArea.Select
        MsgBox "Must selec tthe MARKET you want", , "Missing Market"
        Exit Sub
    Else
        strMkt = Range("F7").Value
    End If
    
    Application.ScreenUpdating = False
    Sheets("REPORT").Range("C17:G" & Rows.Count).Clear
    
    With Sheets(strDay)
        Set rngCopy = .Rows(1).Find(strMkt, , xlValues, xlWhole)
        If .Cells(Rows.Count, rngCopy.Column).End(xlUp).Row < 14 Then Exit Sub  'No information to copy
        Set rngCopy = Range(.Cells(14, rngCopy.Column), .Cells(.Rows.Count, rngCopy.Column).End(xlUp)).Resize(, 5)
    End With
    
    With Sheets("REPORT")
        rngCopy.Copy
        With .Range("C17")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
        .Select
        .Range("C17").End(xlDown).Offset(1).Select
    End With
    Application.ScreenUpdating = True
    
End Sub