combine two codes

[Ali M]

Hi
I want combining two codes
first

Sub test()
   
    Dim OUTrng As Range
    Set wsOUT = Sheets("OUT")
    activesheet.Range("A1").CurrentRegion.Copy wsOUT.Range("A1")
    Set OUTrng = activesheet.Range("A1").CurrentRegion
    With OUTrng
        .AutoFilter 5, ""
        .AutoFilter 6, ""
        Application.DisplayAlerts= False
        .Offset(1).SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts= True
        .AutoFilter
    End With
End Sub

second

Sub copysheet()
    Dim ws As Worksheet, StrPath As String
    Application.DisplayAlerts = False
    StrPath = ActiveWorkbook.Path & "\"
    Set ws = MONTHLY
        ws.Copy
        wb_name = ws.Name
        ActiveWorkbook.SaveAs Filename:= _
            StrPath & " RTP " & Format(Date, "MM-DD-yyyy") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

so the open file should search for the empty or zero value for columns E,F together if so then should delete it and save file as xlsx with same formatting and borders.
any help will be appreciated .

 

[rlv01]

Perhaps something like this (not tested)

Sub combined()
    Dim OUTrng As Range
    Dim ws As Worksheet, StrPath As String
    '    Set wsOUT = Sheets("OUT")
    '    ActiveSheet.Range("A1").CurrentRegion.Copy wsOUT.Range("A1")
    Set OUTrng = ActiveSheet.Range("A1").CurrentRegion
    With OUTrng
        .AutoFilter 5, ""
        .AutoFilter 6, ""
        Application.DisplayAlerts = False
        .Offset(1).SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
        .AutoFilter
    End With

    Application.DisplayAlerts = False
    StrPath = ActiveWorkbook.Path & "\"
    Set ws = ActiveSheet                              'MONTHLY
    ws.Copy
    'wb_name = ws.Name
    ActiveWorkbook.SaveAs Filename:=StrPath & " RTP " & Format(Date, "MM-DD-yyyy") & ".xlsx", FileFormat:=51
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub

 

[Ali M]

thanks for this trying . it just saves as in orginal data in open file without filter as in first code.

 

[dave3009]

Your code is really unclear, making it difficult to determine what's going where and what should be acted on.

You've got data being copied from active sheet to wsOUT, then action happening on active sheet.
You set ws to MONTHLY then take action on active sheet.

Try to be explicit with your references and qualifiers, then it will be easier to combine.

In answer to the 'how to combine?"

Sub RunBoth()
test
copysheet
End Sub

If you have multiple separate actions it is generally wise to keep them separate so you can call each independently.

 

[Ali M]

@dave3009 my goal when save the file as xlsx should filter data based on first code with keep orignal data in open file without any change .

 

[rlv01]

I tested it and it works ok. The blank Col E/F rows were deleted and a new file was saved as per your orginal code. The original file was not closed. I suspect you ran it on data that did not have blank rows to filter.

Before

tmpB.xlsm
	A	B	C	D	E	F	G	H	I
1	ductwork	feedbag	unnooked	redbuds	overlap	zikurats	apollonia	romaunt	photalgia
2	Row 1	trappose	celled	skidding	however		huck	warree	glottic
3	Row 2	pataque	obscurest	keddahs		hirers	sigger	clarts	calcar
4	Row 3	notabene	bepaid	tapsterly	oceanian		perche	scheduled	panels
5	Row 4	granch	handy	mikir	galleass	returners	hordarian	macrourid	wastland
6	Row 5	glum	kiva	kendal		pedary	seragli	valours	vehicle
7	Row 6	kestrel	upholding	personate	affydavy		bludging	imaginate	seawards
8	Row 7	carneol	transhape	champacs	pentine	caravans	dodecant	recountal	pettish
9	Row 8	whirred	hemipodan	ornation		kestrel	deforcing	vervet	epeisodia
10	Row 9	obduracy	advancing	keddahs	firetower	niblic	laurin	ranarium	washery
11	Row 10	cierzo	dovekies	imaginate			muggs	fluxation	posh
12	Row 11	woozy	neuronist	wekau			yearnings	maneges	obscurest
13	Row 12	grown	errors	campanula			sharpen	glochids	tinne
14	Row 13	granules	dolmans	billed			drokpa	fistlike	triosteum
15	Row 14	leveche	involucel	peritura			vitaceae	querendi	bassi
16	Row 15	plewch	tongs	demisang		champacs	bottier	outseek	chylous
17	Row 16	mungcorn	triarian	amphioxi	arapaho	betowered	blindweed	mikir	paper
18	Row 17	shouter	salariego	toadish	closest	romaunt	scarfless	masonries	beeware
19	Row 18	kapelle	deirid	unsharing			rootle	recountal	nitrating
20	Row 19	diopters	zenonian	akkadian			targing	foys	agrias
21	Row 20	tarriers	unvetoed	fibrinose			immerging	midcourse	tetrose
22	Row 21	dillweed	frowsily	cask	furfural	unleft	rewrought	interhyal	baffed
Sheet13

After

tmpB.xlsm
	A	B	C	D	E	F	G	H	I
1	ductwork	feedbag	unnooked	redbuds	overlap	zikurats	apollonia	romaunt	photalgia
2	Row 1	trappose	celled	skidding	however		huck	warree	glottic
3	Row 2	pataque	obscurest	keddahs		hirers	sigger	clarts	calcar
4	Row 3	notabene	bepaid	tapsterly	oceanian		perche	scheduled	panels
5	Row 4	granch	handy	mikir	galleass	returners	hordarian	macrourid	wastland
6	Row 5	glum	kiva	kendal		pedary	seragli	valours	vehicle
7	Row 6	kestrel	upholding	personate	affydavy		bludging	imaginate	seawards
8	Row 7	carneol	transhape	champacs	pentine	caravans	dodecant	recountal	pettish
9	Row 8	whirred	hemipodan	ornation		kestrel	deforcing	vervet	epeisodia
10	Row 9	obduracy	advancing	keddahs	firetower	niblic	laurin	ranarium	washery
11	Row 15	plewch	tongs	demisang		champacs	bottier	outseek	chylous
12	Row 16	mungcorn	triarian	amphioxi	arapaho	betowered	blindweed	mikir	paper
13	Row 17	shouter	salariego	toadish	closest	romaunt	scarfless	masonries	beeware
14	Row 21	dillweed	frowsily	cask	furfural	unleft	rewrought	interhyal	baffed
Sheet13

As @dave3009 says you have a lot of elements in your code that do not make sense.

 

[dave3009]

I get the principle of what you are trying to do, but the code is unclear. For example, if you had a different workbook open and active and triggered this macro then it would perform actions on the active workbook. That is a recipe for trouble.

You need to fix that before someone can offer a robust solution.

 

[Ali M]

well ,I will see how I can fix it .

 

[rlv01]

@dave3009 my goal when save the file as xlsx should filter data based on first code with keep orignal data in open file without any change .

The combined code only does what your original code does and your original code will not do that. It will not keep the original data unchanged because, as written, it changes the ActiveSheet data, not the Sheets("OUT") data. If you want the original data not to change then the original code must be changed. For example:

Sub combined()
    Dim OUTrng As Range
    Dim wsOUT As Worksheet, StrPath As String

    Set wsOUT = Sheets("OUT")
    wsOUT.UsedRange.Cells.Clear

    If wsOUT.Name = ActiveSheet.Name Then
        MsgBox "Worksheet '" & wsOUT.Name & "' is the destination worksheet. Please choose another worksheet before running this macro.  ", vbOKOnly Or vbInformation, Application.Name
        Exit Sub
    End If

    Select Case MsgBox("Source worksheet: '" & ActiveSheet.Name & "'" & vbCrLf _
                     & "Destination worksheet: '" & wsOUT.Name & "'" & vbCrLf _
                     & "" & vbCrLf _
                     & "Proceed with data copy?", vbOKCancel Or vbQuestion, Application.Name)
    Case vbCancel
        Exit Sub
    End Select

    ActiveSheet.Range("A1").CurrentRegion.Copy wsOUT.Range("A1")

    Set OUTrng = wsOUT.Range("A1").CurrentRegion
    With OUTrng
        .AutoFilter 5, ""
        .AutoFilter 6, ""
        Application.DisplayAlerts = False
        .Offset(1).SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
        .AutoFilter
    End With

    Application.DisplayAlerts = False
    StrPath = ActiveWorkbook.Path & "\"

    wsOUT.Copy

    ActiveWorkbook.SaveAs Filename:=StrPath & " RTP " & Format(Date, "MM-DD-yyyy") & ".xlsx", FileFormat:=51
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub

 

[Ali M]

@rlv01 thanks for trying to fixing code , honestly I no know how deal with this code , when I change to sheet name OUT based on your version , it gives me message as in first code , I try following your instruction , but I don't understand how works , what I suppose to do?