Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Am I being Ignored, or is my problem too hard?
I ahve posted a 3 times over the past 2 days the same problem and have
gotten no respones. If no one knows how, or it is not possible, Please let me know. Any response is a good resonse at this point Again here is my problem. I am trying to write a Sub that will lookup the 36-40 file names on sheet(2) column E of my MAIN wrkbook. It will then go into each of the 36-40 wrkbooks , sheet(1) of each wrkbook, and search down column K. Everywhere there is a "Q" in a column it will copy all info in that row (from column A to H) and then paste that info on Sheet(3) of the MAIN wrkbook. Obviously each new paste will need to be placed at the first empty row. Thanks Ryan |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Am I being Ignored, or is my problem too hard?
Not tested much -- but it did compile.
Option Explicit Sub testme() Dim TempWks As Worksheet Dim myCell As Range Dim DestCell As Range Dim InputRng As Range Dim TempCell As Range Dim TempRngToCheck As Range With Worksheets("sheet2") Set InputRng = .Range("E1", .Cells(.Rows.Count, "E").End(xlUp)) End With With Worksheets("sheet3") 'column A of the next row (based on column K Set DestCell = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, -10) End With For Each myCell In InputRng.Cells Set TempWks = Nothing On Error Resume Next Set TempWks = Workbooks.Open(Filename:=myCell.Value).Worksheets( 1) On Error GoTo 0 If TempWks Is Nothing Then myCell.Offset(0, 1).Value = "Missing file!" Else With TempWks Set TempRngToCheck _ = .Range("k1", .Cells(.Rows.Count, "K").End(xlUp)) End With For Each TempCell In TempRngToCheck.Cells If LCase(TempCell.Value) = LCase("Q") Then 'found a match TempCell.EntireRow.Resize(1, 8).Copy _ Destination:=DestCell Set DestCell = DestCell.Offset(1, 0) End If Next TempCell TempWks.Parent.Close savechanges:=False myCell.Offset(0, 1).Value = "Done" End If Next myCell End Sub sharpie23 wrote: I ahve posted a 3 times over the past 2 days the same problem and have gotten no respones. If no one knows how, or it is not possible, Please let me know. Any response is a good resonse at this point Again here is my problem. I am trying to write a Sub that will lookup the 36-40 file names on sheet(2) column E of my MAIN wrkbook. It will then go into each of the 36-40 wrkbooks , sheet(1) of each wrkbook, and search down column K. Everywhere there is a "Q" in a column it will copy all info in that row (from column A to H) and then paste that info on Sheet(3) of the MAIN wrkbook. Obviously each new paste will need to be placed at the first empty row. Thanks Ryan -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Am I being Ignored, or is my problem too hard?
"sharpie23" wrote in message
oups.com... I ahve posted a 3 times over the past 2 days the same problem and have gotten no respones. If no one knows how, or it is not possible, Please let me know. Any response is a good resonse at this point Again here is my problem. I am trying to write a Sub that will lookup the 36-40 file names on sheet(2) column E of my MAIN wrkbook. It will then go into each of the 36-40 wrkbooks , sheet(1) of each wrkbook, and search down column K. Everywhere there is a "Q" in a column it will copy all info in that row (from column A to H) and then paste that info on Sheet(3) of the MAIN wrkbook. Obviously each new paste will need to be placed at the first empty row. Hi Ryan, I think the following does your job: ============================= Sub MuiltipleSearch() ' Make a search over one or more columns, even not contiguous, ' from one or more workbooks listed in this table, ' located in ActiveSheet (you can list here your 40 Workbooks): ' Top Left ' Filename with path Sheet Cell Address ' ---------------------------------------------------------------- ' C:\Document\Excel\XLS\BBCC1.XLS Sheet1 A20 ' C:\Document\Excel\XLS\BBCC2.XLS Sheet2 D18 ' C:\Document\Excel\XLS\BBCC3.XLS Sheet3 B5 ' ' ListCell is the cell containing the first Filename. ' Dim ListCell As Range, WorkbookLoaded As Boolean Dim i, s, j As Long, n As Long, k As Long Dim SearchColumns As Byte, NumColumns As Byte Dim KeyArray(), MatchFound As Byte Dim SourceCell As Range, TargetCell As Range Dim SourceSheet As Worksheet, TargetSheet As Worksheet Dim FinalSort As Boolean ' User Definitions ' ---------------------------------------------------- Set TargetSheet = Sheets("Sheet1") Set TargetCell = TargetSheet.[I14] Set ListCell = ActiveSheet.[B5] SearchColumns = 1 ' Number of columns to serach in NumColumns = 11 ' From A to K, we must include the I, J empty ones. ' If it is a problem for you I will modify code. ReDim KeyArray(1 To SearchColumns, 1 To 2) ' KeyArray(n, 1) column number (n) to search in ' KeyArray(n, 2) search Key for the n-th column KeyArray(1, 1) = 11 ' which corresponds to column K KeyArray(1, 2) = "Q" ' search Key for column K 'KeyArray(2, 1) = 4 ' ordinal for additionale search Key 'KeyArray(2, 2) = "latte" ' additional search Key FinalSort = True ' True | False (see below) ' ----------------------------------------------------- Application.Calculation = xlCalculationManual Application.ScreenUpdating = False On Error GoTo ErrHandler For Each s In Range(ListCell, ListCell.End(xlDown)) For Each i In Workbooks If i.Name = s Then WorkbookLoaded = True End If Next If WorkbookLoaded Then WorkbookLoaded = False Else Workbooks.Open (s) Set SourceSheet = Sheets(s.Offset(0, 1).Value) Set SourceCell = SourceSheet.Range(s.Offset(0, 2)) End If For Each i In Range(SourceCell, SourceCell.End(xlDown)) n = n + 1 MatchFound = 0 For j = 1 To SearchColumns If i.Offset(0, KeyArray(j, 1) - 1) = KeyArray(j, 2) Then MatchFound = MatchFound + 1 End If Next If MatchFound = SearchColumns Then Range(TargetSheet.Cells(TargetCell.Row + k, TargetCell.Column), _ TargetSheet.Cells(TargetCell.Row + k, TargetCell.Column + NumColumns - 1)) = _ Range(i, i.Offset(0, NumColumns - 1)).Value k = k + 1 End If Next ActiveWorkbook.Close SaveChanges:=False Next ' You must define here Sort parameters (Max 3) If FinalSort Then Range(TargetCell, TargetCell.End(xlDown). _ Offset(0, NumColumns - 1)).Sort _ Key1:=TargetCell.Offset(-1, 2), _ Order1:=xlAscending, _ Key2:=TargetCell.Offset(-1, 4), _ Order2:=xlDescending, _ Orientation:=xlSortColumns, _ MatchCase:=True, _ Header:=xlNo End If Exit_Sub: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _ "Procedu " & "Sub MuiltipleSearch()" & vbCrLf & ThisWorkbook.FullName Resume Exit_Sub End Sub ================================ Let me know how it works for you. Try without any ca it doesn't modify your source data. Ciao Bruno |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Am I being Ignored, or is my problem too hard?
THis may help you get some of it. I'm not a programming expert so would
rather let others answer your question more specifically. "sharpie23" wrote in message oups.com... I ahve posted a 3 times over the past 2 days the same problem and have gotten no respones. If no one knows how, or it is not possible, Please let me know. Any response is a good resonse at this point Again here is my problem. I am trying to write a Sub that will lookup the 36-40 file names on sheet(2) column E of my MAIN wrkbook. It will then go into each of the 36-40 wrkbooks , sheet(1) of each wrkbook, and search down column K. Everywhere there is a "Q" in a column it will copy all info in that row (from column A to H) and then paste that info on Sheet(3) of the MAIN wrkbook. Obviously each new paste will need to be placed at the first empty row. Thanks Ryan |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Little Problem, Difficult and Hard. | Excel Discussion (Misc queries) | |||
Begineer with (seemingly) hard problem | Excel Discussion (Misc queries) | |||
[sos]OWC datasorce hard problem with asp.net | Excel Programming | |||
URGENT.....Simple problem...made hard?? | Excel Programming | |||
HARD PROBLEM! Need help stat! | Excel Programming |