speed88bump
New Member
- Joined
- Aug 9, 2013
- Messages
- 29
I am writing a procedure that will require multiple uses of the For Each statement and If Statements in between. I am having a very hard time wrapping my head around this, as such I am having a hard time writing it. I am hoping you guys can help me make since of it all.
I have a Master sheet within Excel in which that macro is in. Within this workbook it has 3 sheets. ST, SH and Data Files.
The Data Files Worksheet starting in Cell H3 has a list of the Folder\File Names locations from the Workbooks I need to pull data from. (Within each workbook is 1-5 separate worksheets in which I will need to extract data from based on criteria).
Starting in Cell B3 of the Data Files Worksheet I have Filenames listed separate from the Folder\File Names mentioned previously.
I am needing to open up each Workbook listed as "read only" and For each worksheet select Row 36 and search for today's date. If not true then go to next worksheet. If True, Then select cell and set as strRng Select entire Column and Offset -1 to select previous column and Hide Selected Columns to Q:Q.
The data can be filtered or I assume it may be easier to reference an adjacent cell like an index match not sure. One problem with filtering is when the Next cell is selected it may not be the visible cell and pull data from the wrong cell.
I used autofilter method. There are filters from B37:P37 on each worksheet. I filtered O37 (Field 14) = "BALANCE" Then starting in strRng until last row For Each cell that is < 0 I need to extract that cell and input it into the Master Workbook Column E contains either an ST or SH If the cell in column E = ST it will go into the Master Workbook Sheet ST and if SH into sheet SH. Example if the cell = ST then it needs to extract the adjoining cell in column H and extract/copy/paste it to sheet ST and placed in the first empty cell in column E. The Negative number it found under "BALANCE" would be selected along with the next 3 cells to the right and Copied/Pasted into ST column E (which is under a field with today's date each column after that is the next day). I need it to also extract Col K and place it in ST Col B, Col C to ST C, Col H to ST I. Then go to next Cell and continue this until it is complete.
Once it has gone through each worksheet it will close without saving the file it opened. and move to the next file listed on the Data Files Work Sheet. And do this until it has gone through all files listed.
I have a Master sheet within Excel in which that macro is in. Within this workbook it has 3 sheets. ST, SH and Data Files.
The Data Files Worksheet starting in Cell H3 has a list of the Folder\File Names locations from the Workbooks I need to pull data from. (Within each workbook is 1-5 separate worksheets in which I will need to extract data from based on criteria).
Starting in Cell B3 of the Data Files Worksheet I have Filenames listed separate from the Folder\File Names mentioned previously.
I am needing to open up each Workbook listed as "read only" and For each worksheet select Row 36 and search for today's date. If not true then go to next worksheet. If True, Then select cell and set as strRng Select entire Column and Offset -1 to select previous column and Hide Selected Columns to Q:Q.
The data can be filtered or I assume it may be easier to reference an adjacent cell like an index match not sure. One problem with filtering is when the Next cell is selected it may not be the visible cell and pull data from the wrong cell.
I used autofilter method. There are filters from B37:P37 on each worksheet. I filtered O37 (Field 14) = "BALANCE" Then starting in strRng until last row For Each cell that is < 0 I need to extract that cell and input it into the Master Workbook Column E contains either an ST or SH If the cell in column E = ST it will go into the Master Workbook Sheet ST and if SH into sheet SH. Example if the cell = ST then it needs to extract the adjoining cell in column H and extract/copy/paste it to sheet ST and placed in the first empty cell in column E. The Negative number it found under "BALANCE" would be selected along with the next 3 cells to the right and Copied/Pasted into ST column E (which is under a field with today's date each column after that is the next day). I need it to also extract Col K and place it in ST Col B, Col C to ST C, Col H to ST I. Then go to next Cell and continue this until it is complete.
Once it has gone through each worksheet it will close without saving the file it opened. and move to the next file listed on the Data Files Work Sheet. And do this until it has gone through all files listed.
Code:
Sub CreateSubsetWorkbook()
Dim wbkOutput As Workbook, WKB As Workbook
Dim wksOutputA As Worksheet, wksOutputB As Worksheet, wks As Worksheet
Dim lngLastRow As Long, LngLastCol As Long, lngDateRow As Long, Lrow As Long, LLRow As Long
Dim rngFull As Range, rngResult As Range, rngTarget As Range, My_Range As Range, MyRange As Range, strRng As Range
Dim strStart As String, strEnd As String
Dim MyPath As String
Set wbkOutput = Workbooks("Auto GEMBA Generation.xlsm")
'Create a new worksheet in the output workbook
Set wksOutputA = Sheets("Struts")
Set wksOutputB = Sheets("Shocks")
strStart = Sheets("Struts").Range("E1").Value
strEnd = Sheets("Struts").Range("H1").Value
Sheets("Data Files").Select
Set My_Range = Range("H2:H13") '& LastRow(ActiveSheet))
If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new workbook"
Exit Sub
End If
With Sheets("Data Files")
Lrow = .Cells(Rows.Count, "H").End(xlUp).Row
For Each cell In .Range("H3:H" & Lrow)
MyPath = cell
Range(cell).Select
WKB = ActiveCell.Offset(0, -6).Value
WKB.Open (cell), ReadOnly:=True
WKB.Activate
'Loop through each worksheet
For Each wks In ThisWorkbook.Worksheets
With wks
Rows(36).Select
If Cells.Find(What:=strStart, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate = True Then
Set strRng = ActiveCell
LngLastCol = ActiveCell.Columns("A:A").EntireColumn
LLRow = .Cells(Rows.Count, "strRng").End(xlUp).Row
For Each cell In .Range("strRng" & LLRow)
If cell < 0 Then
Set MyRange = Range("strRng" & LastRow(ActiveSheet))
'Create a destination range on the new worksheet that we
'will copy our filtered data to
Set rngTarget = wksOutputA.Cells(5, 2)
'Identify the data range on this sheet for the autofilter step
'by finding the last row and the last column
lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, LngLastCol))
'Apply a filter to the full range to get only rows that
'are in between the input dates
With rngFull
.AutoFilter Field:=lngDateRow, _
Criteria1:=">=" & StartDate, _
Criteria2:="<=" & EndDate
'Copy only the visible cells and paste to the
'new worksheet in our output workbook
Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
rngResult.Copy Destination:=rngTarget
End With
'Clear the autofilter safely
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
Next wks
End With
'Let the user know our macro has finished!
MsgBox "Data transferred!"
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Last edited by a moderator: