Declanscully
New Member
- Joined
- Mar 5, 2013
- Messages
- 12
I was helped out with and subsequentially modified a bit. This works but I was wondering if there is a way to modify it so that the BOLDED section can be more dynamic.
Essentially I want to try is:
Sequentially search cells C15 of the opened wb2. Search would be looking for the letters OT. If no OT was found then the Cell B15 would be entered into Cell I5 ofwb1 (.Offset(, 8).Value = wb2.Worksheets(i).Range("B15").MergeArea.Value). If OT was found, the value would be entered into Cell I6 of wb1.
Then it would search Cell B16 etc. until it hits an empty cell at which point it would move on to the next worksheet as it currently does.
I think I can figure out a way to brute force it, but was wondering if there is an elegant solution.
Essentially I want to try is:
Sequentially search cells C15 of the opened wb2. Search would be looking for the letters OT. If no OT was found then the Cell B15 would be entered into Cell I5 ofwb1 (.Offset(, 8).Value = wb2.Worksheets(i).Range("B15").MergeArea.Value). If OT was found, the value would be entered into Cell I6 of wb1.
Then it would search Cell B16 etc. until it hits an empty cell at which point it would move on to the next worksheet as it currently does.
I think I can figure out a way to brute force it, but was wondering if there is an elegant solution.
VBA Code:
Sub IMPORT_DATA()
Application.ScreenUpdating = False
Application.Calculation = False
Const FirstRow As Long = 4
Const InitialFileName = "c:\"
Dim FileName As String
FileName = getFileName(InitialFileName)
If Len(FileName) = 0 Then Exit Sub 'exits sub if no file name is selected
Dim wb2 As Workbook
Dim sh As Worksheets
Dim lr As Long, i As Long
lr = FirstRow
If Len(FileName) > 0 Then
Set wb2 = Workbooks.Open(FileName)
End If
For i = 3 To wb2.Worksheets.Count 'Starts workbook search after rate sheets
lr = lr + 1 'sets start row as 5
With ThisWorkbook.Worksheets("JOB NUMBER").Range("A" & lr) '<----- Change as required
.Value = CStr(wb2.Worksheets(i).Name)
.Offset(, 1).Value = wb2.Worksheets(i).Range("J61").MergeArea.Value
.Offset(, 2).Value = wb2.Worksheets(i).Range("J27").MergeArea.Value
.Offset(, 4).Value = wb2.Worksheets(i).Range("J39").MergeArea.Value
.Offset(, 6).Value = wb2.Worksheets(i).Range("J50").MergeArea.Value
.Offset(, 7).Value = wb2.Worksheets(i).Range("J60").MergeArea.Value
[B].Offset(, 8).Value = wb2.Worksheets(i).Range("B15").MergeArea.Value
.Offset(, 9).Value = wb2.Worksheets(i).Range("B16").MergeArea.Value
.Offset(, 10).Value = wb2.Worksheets(i).Range("B17").MergeArea.Value
.Offset(, 11).Value = wb2.Worksheets(i).Range("B18").MergeArea.Value
.Offset(, 12).Value = wb2.Worksheets(i).Range("B19").MergeArea.Value
.Offset(, 13).Value = wb2.Worksheets(i).Range("B20").MergeArea.Value[/B]
End With
Next i
wb2.Close False
Application.ScreenUpdating = True
Application.Calculation = True
End Sub
Public Function getFileName(Optional InitialFileName As String) As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select the a File"
.InitialFileName = InitialFileName
.Filters.Clear
.Filters.Add "Excel files", "*.xls*"
'.Filters.Add "All files", "*.csv"
'.Filters.Add "All files", "*.*"
If .Show = -1 Then
getFileName = .SelectedItems(1)
End If
End With
End Function