Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Dynamic List Copying with Excel VBA 3

Status
Not open for further replies.

dabowles

MIS
Jun 26, 2001
64
0
0
US
Hello,

I am trying to develop a loop that I can use to search a list that is dynamic in length and find a "start" point and an "end" point and then take that data and copy it to another sheet. The length of the data will change depending on the time of day. The list is composed of times in the first column and other data in the other columns. At different times of the day, the list will be longer than others. For example, if the report is ran at 9:00AM, then the times of 00:00 through 8:59 will be displayed and if the report was ran at 17:30 then 00:00 through 17:29 will be displayed. Now in a list of data there are multiple reports so there may be four different reports going from 00:00 to 17:30. This entire raw report will be pasted in a sheet by itself and I need the algorithm to get the data from the first list and I can figure out the rest. I need the loop to go to the first 00:00 in the list and then somehow find the last line of data for that individual time frame report. The only way I can think of (since there are no delimiters) is to tell it to go to the next 00:00 and move up one row, which would be the last line of data for the current set. Once this range is found I need the range to be copied to sheet X. I am assuming I would need a For Each loop, but how would I set it up? I'm sure it's relatively easy, but right now it has blown my mind.

Thanks for your help,

David B.
 
Hi David,

Not entirely sure of how much you need here. There is nothing wrong with finding the next "00:00" and stepping back up 1 row - is it just that you don't know how to do it?. The following is very simple and assumes your times are in Column A and the first "00:00" is in Row 1 - you will need to adapt it if not - post back if you need help with this.

Code:
Dim StartCell As Range
Dim EndCell As Range

Set StartCell = Range("A1")

Set EndCell = Columns("A:A").Find(What:="00:00", After:=StartCell, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).Offset(-1)
   
Range(StartCell, EndCell).Copy Destination:=Range("Sheet2!A1")

Enjoy,
Tony
 
I appreciate the reply and it helped. The problem I am running into now is 0:00 may be on A1, or it may be on A10, just depending on how the data pulls when the telnet buffer is copied into the sheet. Here is how I adapted your code to my needs:

Sub CopyALBYGate()

Dim StartCell As Range
Dim FirstCell As Range
Dim EndCell As Range

Set StartCell = Range("A1")

Set FirstCell = Columns("A:A").Find(What:="0:00", After:=StartCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns)

Set EndCell = Columns("A:A").Find(What:="0:00", After:=FirstCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Offset(-1)

Range(FirstCell, EndCell).EntireRow.Select
Selection.Cut
Sheets("ALBY Gate").Select
Range("A5").Select
ActiveSheet.Paste

End Sub


First of all using the code you gave me in its original form only copied the first column in each row, and I just expanded it to cut instead of copy and to select the entire row. How can I tell it to search for both the first 0:00 and then do the offset - 1 at the last 0:00? The way I have it now, I implemented a FirstCell var so that way it could know to look for the first 0:00 after the StartCell (which will always be A1) and then the EndCell will come after the StartCell forcing Excel to overlook the first 0:00. The problem is somehow it only will select 0:00, 0:15, 0:30, 0:45 and it stops at the 45. Maybe I am making this too difficult. Is there any other way that I can have it to search for the first 0:00 and the last 0:00-1? By the way also, whenever I used your algorithm, and forced the first 0:00 to be in A1, it would only select the first 0:00, so it was not going past it, hence the reason why I had to adapt the code.

Thanks again for your time and help,

David B.
 
Hi David,

Sorry it's taken me a while to get back. There's a lot there.

Yes, my code did only copy the first row and your change is fine although, in general, it is not necessary to SELECT a range in order to work with it - it just slows the process down. Your "FirstCell" change should also be good.

If I understand correctly having found the first occurrence of "00:00" from the top you then want to find the last occurrence rather than the next occurrence. If you add a "LastCell" to your code and look UP from that you can find that:

Code:
Sub CopyALBYGate()

Dim StartCell As Range
Dim FirstCell As Range
Dim EndCell As Range
Code:
Dim LastCell As Range
Code:
Set StartCell = Range("A1")
    
Set FirstCell = Columns("A:A").Find(What:="0:00", After:=StartCell, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns)
Code:
Set LastCell = Range("A65536").End(xlUp)
Code:
Set EndCell = Columns("A:A").Find(What:="0:00", After:=
Code:
LastCell
Code:
, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns,
Code:
_
    SearchDirection:=xlPrevious
Code:
).Offset(-1)

Range(FirstCell, EndCell).EntireRow.Select
    Selection.Cut
    Sheets("Sheet2").Select
    Range("A5").Select
    ActiveSheet.Paste

End Sub

I'm afraid I don't follow what you are saying about the 0:15, 0:30, etc., but I did notice one problem when I was testing this and that is that my times SHOWED as, say, "01:00" but were actually HELD as "01:00:00" so my Find was not finding what I wanted.

Hope it all helps. If I've misunderstood something, come back to me.

Enjoy,
Tony
 
Tony,

Your solution was helpful again, but I actually have multiple "0:00" through "23:59" reports in one telnet buffer paste. I have yet refined the coding a little more and this is what I have came up with:

Sub CopyALBYGATE()

Dim StartCell As Range
Dim FirstCell As Range
Dim EndCell As Range

Set StartCell = Range("A1")

Set FirstCell = Columns("A").Find(What:="----------------", After:=StartCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).Offset(1)

Set EndCell = Columns("A").FindNext(After:=FirstCell).Offset(-1, 13)

'Range(FirstCell, EndCell).EntireRow.Cut ("ALBY Gate!A5")

'Range(FirstCell, EndCell).Cut Destination:=Range("ALBY Gate!A5")

Range(FirstCell, EndCell).Copy

Sheets("ALBY Gate").Select
Range("A5").Select
ActiveSheet.Paste

End Sub


I was unable to use the search by "0:00" because Excel will not go past the first one and find the next "0:00" - 1. Before this code gets executed, I have another macro that runs through and cleans up any extra junk like report headings, time/date the report was printed, organization name, etc. One of the byproducts of the "junk" are "------"'s that separate the individual reports. This is my search criteria now. I have it look for the first group of minuses, offset by 1 and then copy to the next group of minuses, offset by -1. The last problem that I am having, though I have researched everywhere and get nothing but ambiguous answers, when I execute the code above, I get an error "Runtime Error 1004: Application Defined or Object-Defined Error". I understand this basically means that Excel threw back an error that VBA doesn't have an error code or explanation for. This error occurs at the "Range("A5").Select" line at the end. I have two more lines that are rem'ed out of different ways to copy and paste the data from the sheet that its on to another. These two different styles of doing it was from "Writing Excel Macros" by O'Reilly. Each method renders a Runtime Error 1004. Have you ever seen that before? I figured that something was funky with my Excel distro, so I took it to Excel XP at work and it did the same thing.

Any advice again will be greatly appreciated.

Thanks,

David B.
 
Tony or Anyone else for that matter,

I think I have found my problem. I cannot find any specific documentation on the proper procedures on programatticaly switching sheets in Excel. In my case I am moving data from one sheet to another. Should I have my macro stored in a module or in a sheet? I would assume a module so that it will remain global. However I was getting the RT Error 1004 in the last posting I made above. I was able to resolve it by trial and error by inserting a Sheets("Sheet Name").Activate in before a select. I don't understand why that fixed it, but it did. All of the examples I have seen only require you to code a Sheets("Sheet Name").Select each time you are going to manipulate a different sheet. Here is my current code:
Sub CopyALBYGATE()

Sheets("ClearStuff").Select

Dim StartCell As Range
Dim FirstCell As Range
Dim EndCell As Range
Dim Dave As Range

Set StartCell = Range("A1")

Set FirstCell = Columns("A").Find(What:="----------------", After:=StartCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).Offset(1)

Set EndCell = Columns("A").FindNext(After:=FirstCell).Offset(-1, 13)

Range(FirstCell, EndCell).Cut
Worksheets("ALBY Gate").Activate
Sheets("ALBY Gate").Range("A5").Select
ActiveSheet.Paste

Worksheets("ClearStuff").Activate
Sheets("ClearStuff").Select


Set Dashes = Range("A1")

Set Dashes = Columns("A").Find(What:="----------------", After:=StartCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).Offset(0, 13)

Range(Dashes).Delete

End Sub

I have successfully made it copy the data from the "ClearStuff" sheet. It has then taken that data and moved it to the "ALBY Gate" sheet. The problem is I set it to select the "ClearStuff" sheet again. It seems to select that sheet but whenever I create another var called "Dashes" to find the set of dashes I just acted on to delete it so I can move on to the next set I get the RT 1004 error. I also performed a test where I told it to set Dashes = Range("A1") to see if it was choking on the assignment and it gave me a RT Error 1004 when I tried to select Dashes. Obviously I am not doing something correctly on moving between sheets. Does anyone have an idea of the proper way to "select/deselect" sheets or do you have to "activate/deactivate" them?

Thanks again,

David B.
 
Hi David,

Sorry for not replying. I was out all day yesterday. Very briefly when you are working across multiple sheets you need to be fairly explicit referencing each sheet - otherwise excel doesn't know which one you mean especially when you have one sheet active and a range in another selected. I will answer properly when I have read your posts properly.

Tony
 
Hi David,

Sorry, again, for leaving you struggling. I think this is getting too complex so let's try and clear it up.

Firstly, you generally want to avoid Activating and Selecting ranges in your code. They rarely have any useful effect and always slow your code down. In this respect the book samples would be better choices than the one you are using.

Secondly, the rather unhelpful runtime 1004 error is Excel’s way of telling you one of the parameters you are passing is wrong. Often this is because you give a string instead of a range object but in your case it is probably because Excel cannot resolve the range from the definition you have given.

Using the code that you have to find your range (almost) and then copying and pasting and deleting the rows by explicit naming without selecting, we get:

Code:
 Dim StartCell As Range
Dim FirstCell As Range
Dim EndCell As Range

Set StartCell =
Code:
Sheets("ClearStuff").
Code:
Range("A1")

Set FirstCell = Columns("A").Find(What:="----------------", After:=StartCell, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).Offset(1)
    
Set EndCell = Columns("A").FindNext(After:=FirstCell).Offset(-1, 13)
Code:
Range(FirstCell, EndCell).Copy Destination:=Sheets("ALBY Gate").Range("A5")
'Application.CutCopyMode = False
Range(FirstCell, EndCell).EntireRow.Delete

For some reason I don’t yet know if I use Cut instead of Copy, the wrong rows get deleted. I will post back when I have worked out what is happening. If I can’t work it out I will post a separate question.

Hope this helps. Please post back again if I have left out any bits.

Enjoy,
Tony
 
Tony,

Thank you so much for helping me out, I finally got the code completely finished. It overall takes 18 reports that each report pulls data from midnight to 11:59PM and cuts all of the fluff out and pastes them into another excel sheet that manipulates them to show us an overall summary of call statistics. I work in a CallCenter and am responsible of running all 18 reports every hour. It is currently taking 15-20 minutes out of every hour to run the reports which is extremely time consuming because we have to manually cut and paste each report into their respective sheets. This is going to cut that time down to 5 or less minutes. Again, thank you for taking the time to show me how to properly work with cutting and pasting with sheets in Excel VBA.

Thanks,

David B.
 
David, in case it helps, the following snippet of code is from a test routine that simply assigns shortcuts to each of the workbooks (Worksheets can be done the same way as you will see in the example).

It then uses those shortcuts to reference each of the ranges, and simply says make this range = to that range. No selecting or activating in sight.

Set CurWks = ActiveWorkbook.Worksheets("Summary")

Application.ScreenUpdating = False

lrow = 0
With Application.FileSearch
.SearchSubFolders = True
.NewSearch
.Filename = ".xls"
.LookIn = UserFile
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
Set WB = Application.Workbooks.Open _
(Filename:=.FoundFiles(i))


'Bring in the Data
CurWks.Cells(lrow + 3, "B").Value = WB.Worksheets(1).Range("B3").Value
CurWks.Cells(lrow + 3, "C").Value = WB.Worksheets(1).Range("D3").Value
CurWks.Cells(lrow + 3, "D").Value = WB.Worksheets(1).Range("E7").Value
CurWks.Cells(lrow + 3, "F").Value = WB.Worksheets(1).Range("F6").Value

'Bring in the filename
CurWks.Cells(lrow + 3, "H").Value = WB.FullName

lrow = lrow + 1
WB.Close savechanges:=False
Next
End With


Regards
ken...............
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top