Excel VBA code to locate & copy matching rows

Microsoft Corporation download - microso...
August 25, 2010 at 19:52:58
Specs: Windows 7
Hi –

I’m new to VBA programming in Excel and I’m trying to program a macro to locate certain rows in Worksheet1 in which the text in column A (ex., 1234) is not marked with a Strikethrough (ex., 1234). As the macro finds each occurrence it copies columns 1 through 5 of the found row to Worksheet2 and then goes back to Worksheet1 and continues the search, copy and movement to Worksheet2 until all such rows in Worksheet1 have been located and copied in their found order to Worksheet2. I’ve made several attempts using Range and Find, but none have worked. Can anyone out there give a newbie an assist.

Thank you.


See More: Excel VBA code to locate & copy matching rows

Report •


#1
August 25, 2010 at 19:56:22
Sorry the strikethrough didn't show up on the 2nd (ex., 1234)

Report •

#2
August 25, 2010 at 21:06:36
Since it appears you are willing to try and write the code, why not post what you have tried and we'll see if we can offer some pointers?

You know...learn by doing instead of just being given the answer.


Report •

#3
August 26, 2010 at 15:18:27
Here's the closest I've come. It needs to be cleaned up, but it does work except the rows moved into Worksheet2 are in reverse order to how they appear in Worksheet1 and when the rows are added to Worksheet2 I'm ending up with extra blank rows that are messing up the rest of Worksheet2 that appears below where the rows are being copied.

By way of some explanation, the code starts by moving to Row36 where the condition I'm looking for in the remaining rows starts. Although it works, I'm sure that it can be streamlined and cleaned up a bit. There may even be better and easier commands to use that I've yet to discover.

Thanks.


Sub OutstandingChecks()
'
' Locate,copy and move outstanding checks to next month
' Macro dated 8/25/2010 by BW
'
'
Application.Goto Reference:="R36C1"

With Application.FindFormat.Font
.Strikethrough = False
.Superscript = False
.Subscript = False
End With

Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate

ActiveCell.Resize(1, 6).Copy
ActiveSheet.Next.Select
Rows("37:37").Select
Selection.Insert Shift:=xlDown

ActiveSheet.Previous.Select

For i = ActiveCell.Row - 1 To Cells(Rows.Count, "A").End(xlUp).Row

Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate

ActiveCell.Resize(1, 6).Copy
ActiveSheet.Next.Select
Rows("37:37").Select
Selection.Insert Shift:=xlDown

ActiveSheet.Previous.Select

Next i

End Sub


Report •

Related Solutions

#4
August 26, 2010 at 17:08:56
First, a few coding tips:

1 - Rarely do you have to Select an object to perform a VBA or Excel task on it. You can usually access the object directly. It's much more efficient that way.

For example, this:

ActiveCell.Resize(1, 6).Copy
ActiveSheet.Next.Select
Rows("37:37").Select
Selection.Insert Shift:=xlDown

Can be condensed down to this:

ActiveCell.Resize(1, 6).Copy
ActiveSheet.Next.Rows("37:37").Insert Shift:=xlDown

2 - The reason your data is being copied in reverse order is becasue you are inserting it and shifting the other data down, as opposed to pasting it after the last piece of data in the column.

3 - I don't see any comments in your code. Comments not only help others that are reading the code understand what the author is doing, but - and maybe more importantly - they help the author remember what they are trying to do. You might get this code working and then not look at it for a year. Then a time comes when you need to make a change and you have to spend (waste) time studying the code trying to figure out what you were thinking a year ago before you can make the changes. Comments can help the author (and others) figure out the code much quicker.

Finally, while I commend you on your hard work, I think the use of FindFormat is a little, shall we say, robust for this task. In other words, I think you're doing it the hard way - but I'll bet you learned a lot!

How about something as simple as this:

Option Explicit
Sub OutstandingChecks_V2()
Dim last_sht1_rw, nxt_sht2_rw As Integer
Dim c As Range
'Determine last cells in Sheet1 Column A
  last_sht1_rw = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through checks
   For Each c In Sheets(1).Range("A36:A" & last_sht1_rw)
'Check if Strikethrough Font is False
    If c.Font.Strikethrough = False Then
'If yes, find next empty row in Sheets2 Colmn A
     nxt_sht2_rw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy Sheet1 A:F to Sheet2
      Sheets(1).Range("A" & c.Row & ":F" & c.Row).Copy _
        Destination:=Sheets(2).Range("A" & nxt_sht2_rw)
    End If
   Next
End Sub


Report •

#5
August 31, 2010 at 08:53:06
DerbyDad03 -

Thank you for the assistance and the teaching moment, I can see that I have much to learn. Armed with a book on writing VBA code and macros for Excel I’m in the process of comparing my attempted solution to your streamlined coding to better understand some of the foundational concepts involved. Thanks again.


Report •


Ask Question