Macro Help - Loop through column, find a match for the left 1 or 2 digits, if match copy row beneath to row above

[bblitz]

I am trying to write code that does the following:

I need to loop through column E for any values that start with "DW" or "3".
If a cell starts with "DW" or "3", I would like to copy a range (K:X) in one row beneath the found cell and copy it up one row (row in which "DW" or "3" was found). I would like the paste to start at row Y.

I would like to loop through the entire column and perform the copy/paste function explained above in any instance that DW or 3 is found as the start value for the cell.

Can someone please help with the code?

Thanks, BBLITZ

 

[bblitz]

Forgot to mention Using Excel 97

 

[jc.021286]

Hi there,
give this a quick try

Sub copythrough()
Dim a As Long
a = Cells(65000, 5).End(xlUp).Row

For i = 2 To a
If Left(Cells(i, 5), 2) = "DW" Or Left(Cells(i, 5), 1) = 3 Then
Range(Cells(i - 1, 11), Cells(i - 1, 24)).Copy Destination:=Cells(i, 25)
End If
Next i
End Sub

 

[jc.021286]

In regards to my last post,
I may have gone in the wrong direction and the for statement can start with a 1 instead of 2 and instead of the copying using (-1) it may be +1 for the next row under.

Got confused with under being related to a greater number...

try that and see how you fare,
jc

 

[prabby25101981]

Probably this -

Sub FindandCopy()
Dim LRow As Long
LRow = Range("E65536").End(xlUp).Row
For i = 2 To LRow Step 2
    If Left(Range("E" & i).Value) = "DW" Or Left(Range("E" & i).Value) = "3" Then
        Range("K" & i + 1 & ":X" & i + 1).Copy
        Range("Y" & i).PasteSpecial (xlValues)
    End If
Next
End Sub

Change the 2 in the above code to the row number where the DATA starts...

 

[bblitz]

Prabby and JC

Thanks for your help. However, I got errors on trying both codes at the first Left statement

Prabby, At: If Left(Range("E" & i).Value)... I got error was "compile error: Argument not optional"

JC, At: If Left(Cells(i, 5), 2) = "DW" Or Left(Cells(i, 5), 1) = 3 Then, I got "Run Time 13 error, Type mismatch

I am not familiar with the errors or how to fix as I am new to vba code, any suggestions?

Thanks, B

 

[prabby25101981]

I missed something in my code. Try this. This should work -

Sub FindandCopy()
Dim LRow As Long
LRow = Range("E65536").End(xlUp).Row
For i = 2 To LRow Step 2
    If Left(Range("E" & i).Value, 2) = "DW" Or Left(Range("E" & i).Value) = "3" Then
        Range("K" & i + 1 & ":X" & i + 1).Copy
        Range("Y" & i).PasteSpecial (xlValues)
    End If
Next
End Sub

 

[bblitz]

Hi Prabby,

Again I got the same error, but now on the 2nd Left (underlined) in the statement below. The first time I ran it, I got the error on the 1st Left in the statement.

If Left(Range("E" & i).Value, 2) = "DW" Or Left(Range("E" & i).Value) = "3" Then

Any further suggestions?

Thanks, Bblitz

 

[prabby25101981]

Again I made the same mistake ! Not my day I suppose... Try this -

Sub FindandCopy()
Dim LRow As Long
LRow = Range("E65536").End(xlUp).Row
For i = 2 To LRow Step 2
    If Left(Range("E" & i).Value, 2) = "DW" Or _
           Left(Range("E" & i).Value, 1) = "3" Then
        Range("K" & i + 1 & ":X" & i + 1).Copy
        Range("Y" & i).PasteSpecial (xlValues)
    End If
Next
End Sub

 

[bblitz]

Thanks! This works great. I also had a problem in which I have #value! in the column so i cleaned that up.

Thanks, Betsy