LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Search within range for first populated cell and copy to new workbook


Hi all,

I have been working on my current project for a week or so now and am
learning vba as I go along. I have received lots of help and advice
from other forums but have now hit a major hurdle.

I am running a looped search and retrieve data module over hundreds of
files running over a five year period which basically extracts data
from the files that have predefined criteria ie cell specific, and
pastes the data into a new workbook to create a more user friendly
order history in one place rather than go through each file
individually every time.
The files that the data is extracted from are common, ie a template,
and the same cells are populated throughout.
However, on closer inspection, in one area, sometimes the data is not
in the correct position. Secondly, subsequent amendments are placed in
consecutive sheets. ie original in sheet 1, issue a in sheet 2 issue b
in sheet 3 etc.
From the above, I have two questions.
Q1 I need to prepare a vba statement within my code that literally
says, find the first populated cell (with any content) within a
specified range, copy the data and paste it in the position specified.
Q2 When extracting data from subsequent sheets where the files have
been amended, is it possible to highlight this in my history sheet by
adding (2) when the data has been extracted.

The following code is a segment and I have attached one of the template
files which is consistent with the rest of the files searched.

Any help would be greatly appreciated.

Cheers

Code:
--------------------

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long



Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "H:\treetest\files"
.FileType = msoFileTypeExcelWorkbooks


If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it

Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
Set basebook = ThisWorkbook
rnum = 1

For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("m2")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("l4")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 2). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("c3")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 3). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("h4")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 4). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
* Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("a14")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 5). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i*





wbResults.Close SaveChanges:=True


Next lCount
End If
End With






On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


End Sub

--------------------


The range I wish the search to be in is A14:A38 and I have put the
segment where it is to ho in bold.

Once again,

Thanks

Jeff


+-------------------------------------------------------------------+
|Filename: template.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4735 |
+-------------------------------------------------------------------+

--
1ceman
------------------------------------------------------------------------
1ceman's Profile: http://www.excelforum.com/member.php...o&userid=34213
View this thread: http://www.excelforum.com/showthread...hreadid=539751

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
find last populated cell in range of cells Maximus[_2_] Excel Worksheet Functions 6 July 22nd 09 04:31 PM
can a cell be automatically populated with the workbook name? crawdood Excel Worksheet Functions 4 August 14th 07 04:42 PM
using IF function to copy, but leave populated cell alone [email protected] Excel Worksheet Functions 5 May 12th 06 10:39 PM
search range, if exist, copy cell marcus76 Excel Programming 2 October 11th 04 06:01 PM
Copy Values to Below last Populated Cell Q John Excel Programming 2 June 29th 04 05:28 PM


All times are GMT +1. The time now is 09:55 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"