Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
find last populated cell in range of cells | Excel Worksheet Functions | |||
can a cell be automatically populated with the workbook name? | Excel Worksheet Functions | |||
using IF function to copy, but leave populated cell alone | Excel Worksheet Functions | |||
search range, if exist, copy cell | Excel Programming | |||
Copy Values to Below last Populated Cell Q | Excel Programming |