1
votes

This is continuation of my question from here : How to looping rows and then columns in Excel

I have stumbled another roadblock as I pull all night over this issue: To recap:

I have a table as shown below (B1:L7) Where A1 is lookup values , row B is the header , row C to L is the data.

Column N is the visual representation of end result going to looked like. It is bolded and highlighted for clarity.

Note : Highly discouraged solutions of selecting the whole row and transpose paste due to there are conditional formatting at column N for further analysis.

Excel Table

Here is what I intend to do with the macro below:

  1. Loop the row B using the lookup values in A1 for matching- DONE
  2. Once macro found matching values to lookup values, (i.e :B6 shows matching values to A1) , the values of first 10 values (C to L) (i.e:row 6) are looped to show the values - DONE
  3. All of 10 values are copied at columns N (starting N1 and reiterates downwards to N10) (i.e:C6 values are copied to N1 , D6 to N2 , etc...)
  4. While iterating thru the rows , select the range and paste transpose the values selection in cell N1
    Sub Looping_Click()
    'Search columns
    Dim c As Range
    'Search rows
    Dim r As Range
    'Range to copy and paste values
    Dim i As Range
    
    For Each r In Range(Range("B1"), Range("B1").End(xlDown))
        If r.Value = Range("A1").Value Then
            MsgBox "Found values at " & r.Address
            
            For Each c In Range(r.Offset(0, 1), r.Offset(0, 10))
                MsgBox "Values is " & c.Value
                ''''''''''''''''''''''''''''''''''''''
                MsgBox "Values is " & c.Value
                r.Selection.Copy
                Next i
                ''''''''''''''''''''''''''''''''''''''
                Range("N1").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Next c
        End If
    Next r
    End Sub

The problem is when I running macro, there are no values being pasted at column N as well as RunTimeError 438 pops out I have highlighted the related / suspected troublesome macro parts with '''' Run Time Error 438

1
You do know you can paste values only while transposing, right? That won't overwrite conditional formatting. - BigBen
Or you can use Application.Transpose to transpose the values. - BigBen

1 Answers

4
votes

Please try this approach.

Sub Looping_Click()
    ' 167
    
    Dim Fnd         As Range        ' target to find
    Dim Arr         As Variant      ' values in found row
    Dim R           As Long         ' targeted row

    ' find the value of cell A1 in column B (=columns(2))
    Set Fnd = Columns(2).Find(Cells(1, "A").Value, , xlValues, xlWhole)
    If Fnd Is Nothing Then
        MsgBox "The requested value wans't found.", _
               vbInformation, "Unsuccessful search"
    Else
        ' define a range from the cell where the match was found,
        ' starting 1 cell to the right and then 10 cells wide, 1 row high
        ' read all found values from that range into an array
        Arr = Fnd.Offset(0, 1).Resize(1, 10).Value
        
        ' define a range from the cell N1, make it the same size as the array,
        ' then paste the array to the target range transposing the one column into one row.
        Cells(1, "N").Resize(UBound(Arr, 2), UBound(Arr)).Value = Application.Transpose(Arr)
    End If
End Sub

EDIT:

Referring to your comment, clarity is in the eye of the beholder but one argument would be that the fewer parts a machine has the less complicated it is and therefore the easier it will be to maintain. The above procedure has 3 parts.

  1. Find the matching row.
  2. Copy the values from that row
  3. Paste the copied values to a destination.