Solved

VBA to format

Posted on 2016-07-22
3
89 Views
Last Modified: 2016-07-23
I get some data from the web which i need to format it. I created below code as new to vb i might have taken an lengthy approach.

this is what it does

Once i copy paste data in sheet 1

1.Delete Column A
2.Delete Blank Rows based on column C
3.Add a New sheet with Name "saffolla" - Can i add current day to the file name
4.Copy paste values from Sheet1 to newsheet ("Saffolla 23-07-2016")
5.Change Col to "MM/DD/YYYY" format
6. Autofit all columns in new sheet
7.Update Headings
8. delete sheet1

The challenge that i the macro have to be performed for every new sheet (current day)
and deleting sheet1

Sub FormatIt()
Columns(1).EntireColumn.Delete
 
 Application.ScreenUpdating = False
Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True

Dim rng As Range
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Saffola"
Set rng = Worksheets("Sheet1").Range("A1:F2000")
Worksheets("Saffola").Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
 
    Dim ws As Worksheet
    Set ws = Worksheets("Saffola")
    Columns(1).NumberFormat = "MM/DD/YYYY"
    
       For Each ws In ActiveWorkbook.Worksheets
        With ws.Rows(1).Font
            .Bold = True
        End With
        Application.Goto [A1]
    Next ws
    Worksheets("Saffola").Columns("A:I").AutoFit
    Sheet1.Delete
End Sub

Open in new window

Book1.xlsx
0
Comment
Question by:Nirvana
  • 2
3 Comments
 
LVL 29

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 total points
ID: 41725547
Please try this.....
Option Explicit

Sub FormatIt()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long

Application.ScreenUpdating = False
Set sws = ActiveSheet

sws.Columns(1).Delete
sws.Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
lr = sws.Cells.SpecialCells(xlLastCell).Row

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Saffola " & Format(Date, "dd-mm-yyyy")
Set dws = ActiveSheet
sws.Range("A1:F" & lr).Copy
dws.Range("A1").PasteSpecial xlPasteValues

dws.Columns(1).NumberFormat = "MM/DD/YYYY"
dws.Rows(1).Font.Bold = True
dws.Columns.AutoFit
dws.Range("A1").Select
    
Application.DisplayAlerts = False
sws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

1
 

Author Closing Comment

by:Nirvana
ID: 41726006
great and quick
0
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41726169
Thanks for the feedback. :)
0

Featured Post

Ransomware: The New Cyber Threat & How to Stop It

This infographic explains ransomware, type of malware that blocks access to your files or your systems and holds them hostage until a ransom is paid. It also examines the different types of ransomware and explains what you can do to thwart this sinister online threat.  

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Unhide very hidden sheets with password 22 45
Merging spreadsheets 8 42
Excel VBA - Constants 4 16
ProperCase in Excel (Sheet) 3 12
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question