Filter data from sheets and paste into new sheet using VB

KennyC

New Member
Joined
Jul 23, 2003
Messages
42
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.

ActionPlan.jpg


Cheerz ;^)
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

KennyC

New Member
Joined
Jul 23, 2003
Messages
42
BrianB said:

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.

open.jpg


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????? :cry: :cry: :cry:

Cheerz :) :biggrin: :wink:
 

KennyC

New Member
Joined
Jul 23, 2003
Messages
42
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 :) :biggrin: :wink:
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,498
Messages
5,832,055
Members
430,109
Latest member
govivek

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top