consolidate or create a new vba code for performing tasks

Below are the steps that i want to perform in a excel file

Step 1: Delete first 6 rows
Step 2: Filter by column A and delete blank rows
Step 3: Based on Column "C" Create a new excel file for uniq values (example if have value as "1" in column C for three rows it have to create new file as "Australia_1" in the drive specified by user or in the same drive where the macro is being run

or if i am not clear on the step 3 if i create a pivot by column c and for each value of the count in need a separate file

to perform above tasks I have gathered some code from various websites

I have about 3 codes taken from different websites

The first ( Sub sbVBS_To_Delete_EntireRow_For_Loop()) macro deletes first 6 rows
The Second one  (Sub DeleteRows()) filters Col A and delete blanks
The Third one (parse_data()) copies the data for all the unique values from column C and creates a new sheet
the fourth one (Sub newfile()) create a new work file

I have two questions
1. How can I consolidate all into one code and if possible how can create as an application or UI
2. when creating a new file how can i add a prefix to the file name along with worksheet name (for example every filename starts with "Australia"


Sub sbVBS_To_Delete_EntireRow_For_Loop()
Dim iCntr
For iCntr = 1 To 6 Step 1
Rows(1).EntireRow.Delete
Next
End Sub

Sub DeleteRows()
    With ActiveSheet
        .AutoFilterMode = False 'remove filter
        With .Range("A:Q")
            .AutoFilter field:=1, Criteria1:="="
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
        .AutoFilterMode = False 'remove filter
    End With
End Sub

Open in new window


Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 3
Set ws = Sheets("Customer Ledger Report")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:Q1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

Open in new window


Sub newfile()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xls"
ActiveWorkbook.Close savechanges:=False

Next sht

End Sub

Open in new window

NirvanalearnerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
just some quick replies...

>>1. How can I consolidate all into one code and if possible how can create as an application or UI
You can create a userform in Excel.

Userform
http://www.excel-easy.com/vba/userform.html

>>2. when creating a new file how can i add a prefix to the file name along with worksheet name (for example every filename starts with "Australia"

amend this line in Sub newfile() from:
Filename:=MyPath & "\" & sht.Name & ".xls"

Open in new window

to:
Filename:=MyPath & "\Australia_" & sht.Name & ".xls"

Open in new window

?
NirvanalearnerAuthor Commented:
Thank you Ryan. I have consolidated the code as below. I have couple of questions.

1. How can I create button for macro as part of the tool bar?
2. As part of the file I have do a vlookup from different file and based on column C and add it as part of the file name how can I achieve that?



Sub sbVBS_To_Delete_EntireRow_For_Loop()
Dim iCntr
For iCntr = 1 To 6 Step 1
Rows(1).EntireRow.Delete
Next
    With ActiveSheet
        .AutoFilterMode = False 'remove filter
        With .Range("A:Q")
            .AutoFilter field:=1, Criteria1:="="
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
        .AutoFilterMode = False 'remove filter
    End With

Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 3
Set ws = Sheets("Customer Ledger Report")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:Q1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate

MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\Open Post List-Bring Cargo AS_" & sht.Name & ".xls"
ActiveWorkbook.Close savechanges:=False

Next sht

End Sub

Open in new window

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>if not the user form how can I consolidate all the codes?
you can put your codes into a Public Module. it's still fine if you still want to keep the codes into 4 different sub routines, but you need to link all the relevant sub routines together.

for example:

you are calling Sub1, then you have:
Sub Sub1()
   'Do your stuffs..

   Call Sub2
End Sub

Sub Sub2()
   'Do your stuffs..

   Call SubN
End Sub

Open in new window

And when necessary, you can defined them as a Function instead of Sub so that a value can be returned from the piece of codes, so that you can determine whether the process within the codes is success or not.

hope this understandable and make sense.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
NirvanalearnerAuthor Commented:
Ryan,

I have couple of questions.

1. How can I create button for macro as part of the tool bar?
2. As part of the file I have do a vlookup from different file and based on column C and add it as part of the file name how can I achieve that?
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>1. How can I create button for macro as part of the tool bar?
do you mean to add the command button from the toolbar option?
SnapShot.png
>>2. As part of the file I have do a vlookup from different file and based on column C and add it as part of the file name how can I achieve that?
in macro you can use : Application.WorksheetFunction.VLookup for vlookup function.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.