Filter data from sheets and paste into new sheet using VB

[KennyC]

Hi,

I'm creating a workbook consisting of different worksheets for department Action Plans, consisting of:
Main
Nursing
DT
Launry_Dom
Standards

From worksheets Nursing, DT and Laundry_Dom, there is a row column H that contains either O (Open) or C (Closed).

On the MAIN sheet, I have buttons to run macros:
1) Summary.SummarizeData
2) Summary.SummarizeDataOpen
3) Summary.SummarizeDataClosed

and a button to delete the new worksheet that either of the above subs have created called:

4) dltSheets.dltSheets

What I'm trying to do, if button 1) is pressed:
-----
Private Sub CommandButton1_Click()
Summary.SummarizeData
End Sub
-----

it selects all of the rows from each of the worksheets Nursing, DT and Laundry_Dom etc., and pastes the rows into a newly created worksheet called All

If button 2) is pressed, it searches worksheets Nursing, DT and Laundry_Dom for text "O" in column H and pastes the rows into a newly created worksheet called Open.

If button 3) is pressed, it searches worksheets Nursing, DT and Laundry_Dom for text "C" in column H and pastes the rows into a newly created worksheet called Closed.

Hope it make sense and not to involved.

Cheerz ;^)

 

[BrianB]

This shows the basic method.

http://www.mrexcel.com/board2/viewtopic.php?p=786334#786334

 

[KennyC]

This shows the basic method.

http://www.mrexcel.com/board2/viewtopic.php?p=786334#786334

Hi,

Sorry, I looked, but I wasn't able to figure out what I need to do.

I've got a work around, probably far to big with duplications, but seems to do the job except for 1 thing and I can't workout what I need to do to correct.

I'm using to filter in row H for text "O" or "C" to find records that are OPEN or CLOSED.

It is looking at 7 worksheets and adding rows that meet the FILTER to the bottom of a newly created worksheet called OPEN.

The first part for NURSING filters OK, but the other sheets show ALL records, then the FILTERed rows under.

This image shows how the newly created sheet called OPEN from the 7 worksheets displays. Nursing is OK, but the others in the sheet are wrong.

Sorry for the long code, but I don't know any other way to explain, I'm fairly new to Excel.

Sub SummarizeDataOpen()

Dim x As Long
Dim i As Range

'add the new sheet to the end(right)
'of Open existing sheets
Sheets.Add.Name = "Open"
Worksheets("Open").Move After:=Worksheets("Standards")

Worksheets("Nursing").Range("A1:H4").Copy
Worksheets("Open").Range("A1").PasteSpecial xlPasteAll
Range("A5").PasteSpecial Paste:=xlPasteColumnWidths
Worksheets("Nursing").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Cells.EntireRow.AutoFit

' the line below is calling the Sub SummarizeData2 in this same module.
SummaryOpen.SummarizeDataOpen2
SummaryOpen.SummarizeDataOpen3
SummaryOpen.SummarizeDataOpen4
SummaryOpen.SummarizeDataOpen5
SummaryOpen.SummarizeDataOpen6
SummaryOpen.SummarizeDataOpen7

End Sub

Sub SummarizeDataOpen2()

Dim x As Long
Dim i As Range

Worksheets("DT").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

End Sub

Sub SummarizeDataOpen3()

Dim x As Long
Dim i As Range

Worksheets("PhysioLink").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

Range("A5").Select

End Sub

Sub SummarizeDataOpen4()

Dim x As Long
Dim i As Range

Worksheets("Kitchen").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

Range("A5").Select

End Sub

Sub SummarizeDataOpen5()

Dim x As Long
Dim i As Range

Worksheets("Laundry_Dom").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

Range("A5").Select

End Sub

Sub SummarizeDataOpen6()

Dim x As Long
Dim i As Range

Worksheets("Maintenance").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

Range("A5").Select

End Sub

Sub SummarizeDataOpen7()

Dim x As Long
Dim i As Range

Worksheets("OHS&W").Select

x = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = True
For Each i In Range("A3:A4" & x)
If i.Value <> ("") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i
For Each i In Range("H5:H" & x)
If i.Value = ("O") Then
i.EntireRow.Copy Worksheets("Open").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next i

Worksheets("Open").Select
Cells.EntireRow.AutoFit
Range("A3:H3").RowHeight = 18
Range("A4:H4").RowHeight = 51.75

PrinterSettings.PrntSettingsOpen

Range("A5").Select

End Sub

Can anyone help a NEWBIE please?????

Cheerz :wink:

 

[KennyC]

Hi,

Another thing I can't fix, is rows 1 and 2 change in height, (1) should be 16.5 and (2) should be 11.25.

Cheerz :wink: