Macro for copying cells with specific value in them to another worksheet

[jpenndcl]

I am trying to copy a row of cells from one worksheet to another worksheet if the value of the first cell in the row is a specific letter/number. Does anyone know the macro code to do this?

 

[Krishnakumar]

Hi,

May be..

Sub kTest()
Dim a, v, i As Long, w()

a = Range("A1").CurrentRegion.Resize(, 1)
ReDim w(1 To UBound(a, 1), 1 To 1)
For Each v In a
    If UCase(Left$(v, 1)) = "A" Then 'if the first letter is A
        i = i + 1
        w(i, 1) = v
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(i).Value = w
End With
End Sub

 

[jpenndcl]

Hi,

May be..

Sub kTest()
Dim a, v, i As Long, w()

a = Range("A1").CurrentRegion.Resize(, 1)
ReDim w(1 To UBound(a, 1), 1 To 1)
For Each v In a
    If UCase(Left$(v, 1)) = "A" Then 'if the first letter is A
        i = i + 1
        w(i, 1) = v
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(i).Value = w
End With
End Sub

Worked nicely for copying over the individual letter (In your example, "A"), but didn't copy over the entire row of information


I will provide an example (screen shot wasn't working at the moment)...
Worksheet 1

<table x:str="" style="border-collapse: collapse; width: 144pt;" width="192" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" span="3" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">a</td> <td style="width: 48pt;" width="64">Train</td> <td style="width: 48pt;" width="64">25 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">b</td> <td>car</td> <td>5 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">c</td> <td>boat</td> <td>15 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>28 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>45 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>12 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">c</td> <td>boat</td> <td>2 mph</td> </tr> </tbody></table>

Worksheet 2

<table x:str="" style="border-collapse: collapse; width: 144pt;" width="192" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" span="3" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">a</td> <td style="width: 48pt;" width="64">Train</td> <td style="width: 48pt;" width="64">25 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>28 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>45 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>12 mph</td> </tr> </tbody></table>

 

[Krishnakumar]

Hi,

Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 3) '3 columns
ReDim w(1 To UBound(a, 1), 1 To 3)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "A" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 3: w(n, c) = a(i, c): Next
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(n, 3).Value = w
End With
End Sub

HTH

 

[jpenndcl]

Hi,

Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 3) '3 columns
ReDim w(1 To UBound(a, 1), 1 To 3)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "A" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 3: w(n, c) = a(i, c): Next
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(n, 3).Value = w
End With
End Sub

HTH

for some reason I get an error message from the following code

.Resize(n, 3).Value = w



Also, if I want to expand the selection that is searched for the corresponding values to 7 columns and 200 rows, how do I do that in your code

 

[Krishnakumar]

Hi,

Try,

Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 7) '7 columns
ReDim w(1 To UBound(a, 1), 1 To 7)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "K" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 7: w(n, c) = a(i, c): Next
    End If
Next
If n > 0 Then
    With Sheets("Sheet2").Range("a1")
        .Resize(n, 7).Value = w
    End With
Else
    MsgBox "No record found", vbInformation
End If
End Sub

HTH