VBA help

[mssbass]

I've got a row (Q1:BH1)with mutually exclusive dates. My 2nd row has formulas (Q2:BH2) that pull in related data.
I've also got 1 cell with a specific date (Q13)

If a date on my first row matches to the date in cell Q13, I want to copy/paste special values in the 2nd row in the cell below the matching date in order to get rid of the formula.

 

[wideboydixon]

Public Sub CopyMatchingValue()

Dim foundColumn As Variant

foundColumn = Evaluate("MATCH(Q13,Q1:BH1,0)")
If Not IsError(foundColumn) Then
    With Range("Q2:BH2")(foundColumn)
        .Value = .Value
    End With
End If

End Sub

WBD

 

[mssbass]

Worked great - now I have multiple with statements - how to I clean this up?

Sub B_Finalize()
Dim WKS As Worksheet
Set WKS = ThisWorkbook.Worksheets("3_Vol 295")
Set WKS2 = ThisWorkbook.Worksheets("3_Vol 520")
Set WKS3 = ThisWorkbook.Worksheets("3_Vol 524")
Dim foundColumn As Variant
foundColumn = Evaluate("MATCH(Q13,Q1:BH1,0)")
If Not IsError(foundColumn) Then
With WKS.Range("Q2:BH2")(foundColumn)
.Value = .Value
With WKS.Range("Q3:BH3")(foundColumn)
.Value = .Value
With WKS.Range("Q4:BH4")(foundColumn)
.Value = .Value
With WKS2.Range("Q2:BH2")(foundColumn)
.Value = .Value
With WKS2.Range("Q3:BH3")(foundColumn)
.Value = .Value
With WKS2.Range("Q4:BH4")(foundColumn)
.Value = .Value
With WKS3.Range("Q2:BH2")(foundColumn)
.Value = .Value
With WKS3.Range("Q3:BH3")(foundColumn)
.Value = .Value
With WKS3.Range("Q4:BH4")(foundColumn)
.Value = .Value
End With
End With
End With
End With
End With
End With
End With
End With
End With
End If
End Sub

 

[wideboydixon]

Sub B_Finalize()

Dim sheetArray
Dim thisRow As Long
Dim thisSheet As Long
Dim foundColumn

sheetArray = Array("3_Vol 295", "3_Vol 520", "3_Vol 524")
foundColumn = Evaluate("MATCH(Q13,Q1:BH1,0)")

If IsError(foundColumn) Then Exit Sub

For thisSheet = LBound(sheetArray) To UBound(sheetArray)
    For thisRow = 2 To 4
        With Sheets(sheetArray(thisSheet)).Range("Q" & thisRow & ":BH" & thisRow)(foundColumn)
            .Value = .Value
        End With
    Next thisRow
Next thisSheet

End Sub

Untested.

WBD