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 iCntrFor iCntr = 1 To 6 Step 1Rows(1).EntireRow.DeleteNextEnd SubSub 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 WithEnd Sub
Sub newfile()MyPath = ThisWorkbook.PathFor Each sht In ThisWorkbook.Sheetssht.CopyActiveSheet.Cells.CopyActiveSheet.Cells.PasteSpecial Paste:=xlPasteValuesActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormatsActiveWorkbook.SaveAs _Filename:=MyPath & "\" & sht.Name & ".xls"ActiveWorkbook.Close savechanges:=FalseNext shtEnd Sub
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 iCntrFor iCntr = 1 To 6 Step 1Rows(1).EntireRow.DeleteNext 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 WithDim lr As LongDim ws As WorksheetDim vcol, i As IntegerDim icol As LongDim myarr As VariantDim title As StringDim titlerow As Integervcol = 3Set ws = Sheets("Customer Ledger Report")lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Rowtitle = "A1:Q1"titlerow = ws.Range(title).Cells(1).Rowicol = ws.Columns.Countws.Cells(1, icol) = "Unique"For i = 2 To lrOn Error Resume NextIf ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Thenws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)End IfNextmyarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))ws.Columns(icol).ClearFor i = 2 To UBound(myarr)ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") ThenSheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""ElseSheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)End Ifws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")Sheets(myarr(i) & "").Columns.AutoFitNextws.AutoFilterMode = Falsews.ActivateMyPath = ThisWorkbook.PathFor Each sht In ThisWorkbook.Sheetssht.CopyActiveSheet.Cells.CopyActiveSheet.Cells.PasteSpecial Paste:=xlPasteValuesActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormatsActiveWorkbook.SaveAs _Filename:=MyPath & "\Open Post List-Bring Cargo AS_" & sht.Name & ".xls"ActiveWorkbook.Close savechanges:=FalseNext shtEnd Sub
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?
>>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?
>>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.
>>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:
Open in new window
to:Open in new window
?