Help with macro for Find, Copy, Paste, Repeat

[Tobbes]

I'm having trouble being a noob and all, understanding where to start with the following problem.

I have 10 worksheets. They are labelled 'FEB', 'MAR', 'APR', etc...to 'NOV' (NB: JAN & DEC not needed). In column "G" on all these sheets I have the data as "CURRENT" or "OVERDUE". The first 3 rows on every sheet are headers, so the data starts at 'G4' on every sheet. I then have an "OUTSTANDING" sheet which will display all of the "OVERDUE" items from the various months. I have an UPDATE_Click() event which when actioned needs to search all the column Gs in the month sheets and then copy the data from column 'B' to 'F' of the corressponding row to an "OVERDUE" result. The data from B-F then needs to be pasted in the next available row on the "OUTSTANDING" worksheet (starting at row 4, as first 3 rows are headers with merged and unmerged cells). Nothing fancy, when the search go does the column and hits a blank cell that means its the end of the list and can move on to the next month.

Any help is greatly appriciated!
Please include ample 'Comments in the code.

Cheers, Toby.

 

[jasonb75]

Welcome to the board Toby!

Try this out on a copy of your workbook, It looks as if it's doing what you need with some sample data.

Sub copytest()
Sheets("Outstanding").Select
' start a loop for the sheets, assuming "Feb" is in sheet 1 tab position, "Nov" in sheet 10
For a = 1 To 10
' loop cell range from row 4 to last entry in column G of sheet (a)
For cel = 4 To Sheets(a).Cells(Rows.Count, 7).End(xlUp).Row
' look for "overdue" in 1st cell of Column  G (starting G4)
If Sheets(a).Range("G" & cel).Text = "overdue" Then
' copy B:F in same row when overdue is found
Sheets(a).Range("B" & cel & ":F" & cel).Copy
' Find the next empty row in "outstanding" sheet
Range("B" & Cells(Rows.Count, 2).End(xlUp).Row + 1).Select
' Paste copied data
ActiveSheet.Paste
Application.CutCopyMode = False
End If
' loop to check next cell in Col G
Next
' loop to next sheet
Next
End Sub

Hope this helps.

Jason

 

[Tobbes]

Jason,
Thanks very much for your help.
Unfortunately the sheets are just 10 in a whole bunch of sheets.
I was thinking of using the Find Method or FindNext.
Where I get lost is what I have to define and how to capture the result, copy the cells (maybe using Offset). Pasting to the next row in OUTSTANDING is ok, I'm good with that.
Also, getting it to do it all in the background whilst viewing the OUTSTANDING sheet.
One other thing I shouldn't mention before we go anywhere. The Column 'G' in every month sheet has a formula to display "CURRENT"/"OVERDUE" (i.e. TRUE/FALSE respectively) will that effect the outcome as it wont return text="overdue"?

Thakns again, love the work you guys put into these forums.

 

[jasonb75]

Hi Toby, this revised code will overcome the problem of the random sheet positions, you will nedd to check that the months in the array match those in the tabs of your worksheets, for example, if you have "Sep" in the array while your sheet is called "Sept" it will error out.

To define where to "capture" the data in relation to the search is a matter of preference, the majority of professionals seem to use the Cells and Offset commands for this, as an amatuer my preference (purely as it's the one I can understand easiest) is to use a loop with a variable as the row number, in this code, the variable "cel", then transfer this row number using the variable to the cell ranges that I need to use.

For example, if variable "a" had selected "Mar" as the sheet, and "cel" had a value of 10 from the loop, the line

Sheets(sht(a)).Range("B" & cel & ":F" & cel).Copy

Would mean the same as

Sheets("Mar").Range("B10:F10").copy

As for doing in the background, you're probably used to seeing code like

Sheets("Mar").select
Range("B10:F10").Select
Selection.Copy

Every time "Select" is used, the cursor will move to that location and display it the same as if you selected it with your mouse.

By removing the Select / Selection keywords, you are telling the code that you're not interested in seeing what it's doing, just get on with it! This makes the code run a lot faster, although you might not notice it on small amounts of data.

Finally, your question about column G having a TRUE / FALSE result, this makes no difference, using .Text will use what you see in the cell, not the formula behind it. The only time I have had problems with this is if the Column is too narrow and the text is displayed as #### because it doesn't fit the cell. Changed to .Value as a precaution but don't think it would cause you any problems.

Sub copytest()
Sheets("Outstanding").Select
' array added for name of each sheet to search
sht = Array("Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov")
' start a loop for each sheet in the array, note arrays start at 0 not 1
For a = 0 To 9
' loop cell range from row 4 to last entry in column G of sheet (a)
For cel = 4 To Sheets(sht(a)).Cells(Rows.Count, 7).End(xlUp).Row
' look for "overdue" in 1st cell of Column  G (starting G4)
If Sheets(sht(a)).Range("G" & cel).Value = "overdue" Then
' copy B:F in same row when overdue is found
Sheets(sht(a)).Range("B" & cel & ":F" & cel).Copy
' Find the next empty row in "outstanding" sheet
Range("B" & Cells(Rows.Count, 2).End(xlUp).Row + 1).Select
' Paste copied data
ActiveSheet.Paste
Application.CutCopyMode = False
End If
' loop to check next cell in Col G
Next
' loop to next sheet
Next
End Sub

Hope this helps

Jason

 

[Tobbes]

Jason,

Thanks again. I have learnt a lot there. I have bought the Mr. Excel book for VBA & Macros but have found it targetted to people already in the know.

I have overlooked a fatal error. The 'Status' column displaying the "OVERDUE/CURRENT" data is actually column 'H'. I was able to get through the code and correct it. Also noticed the arrays are case sensitive which I expected. Have it working now, although it pasted the data over some of my headings on the outstanding sheet. I can work that out hopefully. I did notice it copy the first return twice. Hopefully that is linked with the paste error.

Thank you very much for your help.

 

[jasonb75]

Toby,

The duplicates are probably as a result of the code stopping on an error, this would mean if you restart the macro it would repeat what it's already done.

The problem with the first row being copied over your headings, I would imagine is caused by a blank cell in the heading rows where the macro looked for the last row, it looks for the first blank in column B, so if the last row of headers doesn't have an entry in that cell that would cause it, or if cells in A and B are merged I believe that the entry would be classified as located in A, and B would be seen as blank.

Let me know if you need more info

Jason

 

[Tobbes]

It works perfectly! You've done some great work there Jason.

I changed your code for pasting to this

' Find the next empty row in "outstanding" sheet
Range("B65536").End(xlUp).Offset(1, 0).Select
' Paste copied data
ActiveSheet.Paste

How do you think I will go deleting the old data on the "OUTSTANDING" sheet to replace it with the newly found "OVERDUE" items?

Cheers.

 

[jasonb75]

Maybe something like this before the first comment line.

Range("B4:F" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents

I'm curious as to why your edited version of the select and paste code works, when mine didn't. Maybe I'm overlooking something obvious, but as far as I can see both give exactly the same result. Think I'll have to investigate later.

Code above will clear everything from B4 to last used cell in column F, if it doesn't work then I might start thinking your pc has something against me

Jason

 

[Tobbes]

It's a government PC, I wouldn't be surprised.
I think becasue or merged cells it tries to write the data in those cells.
What does the '2' mean in the above code?
I read it as: Range from B4 to F4 and the cells all the way down to the last row, clear their contents.
I just don't get what the 2 does after count and the '.Row' after you've done the xlUp does that just finalise the selection?

 

[Tobbes]

PS The clear contents works perfectly!