I must make certain I have a specific range of numbers present.

A

Accountant Mike

Florida has 67 counties. When I export data from an Acess database into an
Excel database, depending on the monthly report, not all 67 counties are
present. In order to work with the data in other reports, I need to make sure
that column A (the county name/number) has all 67 numeric values.

I made a "clean-up" macro that cleans up all unnecessary info, formats, and
inserts summation formulae where needed. My problem is I want it to also
enter missing county numbers (i.e. make certain 1 - 67 exist) and 0 in the
associated columns.

I'm including the macro here:

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Select

' Delete and shift up
Selection.Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Select

' Delete and shift left
Selection.Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Select

' Activate the range
Range("K1").Activate

' Delete the selection: C,E,G,I,K & shift to left
Selection.Delete Shift:=xlToLeft

' Scroll back to the left
ActiveWindow.ScrollColumn = 1

' Select All of row 1
Rows("1:1").Select

' Center titles horizontally & vertically (format)
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
' End formatting
End With

' Select Columns A thru G
Columns("A:G").Select

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete

' Scroll down to row 70
ActiveWindow.SmallScroll Down:=48

' Select B70 thru G70
Range("B70:G70").Select

' Sum cells 68 thru 1 in each column (B thru G)
Selection.FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").Select

' Write CHECKSUM in active cell (A74)
ActiveCell.FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").Select

' Sum cells: Row 4 up , columns left 4 to left 1
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
Range("A1:A69").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete


End Sub


Any help will be appreciated!!

Accountant Mike
 
P

Per Jessen

Hi

I cleaned up your code and removed all Select statements as they are not
needed, only slowing the macro down.
Also inserted missing county numbers in column a, an added zero values in
column B:H.

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Delete Shift:=xlToLeft

' Center titles horizontally & vertically (format)
With Rows("1:1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
' End formatting
End With

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").SpecialCells(xlCellTypeBlanks).Delete

'Insert missing county's
rw = 3 'First County row
If Range("A" & rw).Value <> 1 Then
Rows(rw).EntireRow.Insert
Range("A" & rw) = 1
Range("B" & rw & ":H" & rw) = 0
End If
rw = rw + 1
County = 1
Do
If Cells(rw, "A").Value <> County + 1 Then
Rows(rw).EntireRow.Insert
Cells(rw, "A") = County + 1
Range("B" & rw & ":H" & rw) = 0
End If
County = County + 1
rw = rw + 1
Loop Until County = 67

' Select B70 thru G70
Range("B70:G70").FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
' Range("A1:A69").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Regards,
PEr

Accountant Mike said:
Florida has 67 counties. When I export data from an Acess database into an
Excel database, depending on the monthly report, not all 67 counties are
present. In order to work with the data in other reports, I need to make
sure
that column A (the county name/number) has all 67 numeric values.

I made a "clean-up" macro that cleans up all unnecessary info, formats,
and
inserts summation formulae where needed. My problem is I want it to also
enter missing county numbers (i.e. make certain 1 - 67 exist) and 0 in the
associated columns.

I'm including the macro here:

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Select

' Delete and shift up
Selection.Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Select

' Delete and shift left
Selection.Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Select

' Activate the range
Range("K1").Activate

' Delete the selection: C,E,G,I,K & shift to left
Selection.Delete Shift:=xlToLeft

' Scroll back to the left
ActiveWindow.ScrollColumn = 1

' Select All of row 1
Rows("1:1").Select

' Center titles horizontally & vertically (format)
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
' End formatting
End With

' Select Columns A thru G
Columns("A:G").Select

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete

' Scroll down to row 70
ActiveWindow.SmallScroll Down:=48

' Select B70 thru G70
Range("B70:G70").Select

' Sum cells 68 thru 1 in each column (B thru G)
Selection.FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").Select

' Write CHECKSUM in active cell (A74)
ActiveCell.FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").Select

' Sum cells: Row 4 up , columns left 4 to left 1
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
Range("A1:A69").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete


End Sub


Any help will be appreciated!!

Accountant Mike
Click to expand...
 
R

Ryan H

It would be much better if you post the entire code. Because sometimes you
may think it doesn't affect what you post but chances are it does.

Plus there is no need to use Select in your code. This just slows things
down.

You need to be much more specific on were you want the county numbers to go.
Where do the county numbers get inserted, which column, which row, does the
county name have to go in the same cell as the number as well?

Please be more specific and post all of your code. I will be happy to clean
alot of the code up which will make it much more efficient.
--
Cheers,
Ryan


Accountant Mike said:
Florida has 67 counties. When I export data from an Acess database into an
Excel database, depending on the monthly report, not all 67 counties are
present. In order to work with the data in other reports, I need to make sure
that column A (the county name/number) has all 67 numeric values.

I made a "clean-up" macro that cleans up all unnecessary info, formats, and
inserts summation formulae where needed. My problem is I want it to also
enter missing county numbers (i.e. make certain 1 - 67 exist) and 0 in the
associated columns.

I'm including the macro here:

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Select

' Delete and shift up
Selection.Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Select

' Delete and shift left
Selection.Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Select

' Activate the range
Range("K1").Activate

' Delete the selection: C,E,G,I,K & shift to left
Selection.Delete Shift:=xlToLeft

' Scroll back to the left
ActiveWindow.ScrollColumn = 1

' Select All of row 1
Rows("1:1").Select

' Center titles horizontally & vertically (format)
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
' End formatting
End With

' Select Columns A thru G
Columns("A:G").Select

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete

' Scroll down to row 70
ActiveWindow.SmallScroll Down:=48

' Select B70 thru G70
Range("B70:G70").Select

' Sum cells 68 thru 1 in each column (B thru G)
Selection.FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").Select

' Write CHECKSUM in active cell (A74)
ActiveCell.FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").Select

' Sum cells: Row 4 up , columns left 4 to left 1
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
Range("A1:A69").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete


End Sub


Any help will be appreciated!!

Accountant Mike
Click to expand...
 
A

Accountant Mike

Thanks so much for your help!! The original code was simply a macro I
recorded, so I guess that's why the 'selects' were in there. I'm reading this
at home, so I can't try it, but I will first thing in the morning as soon as
I get to work.

Thanks again for both replies.

Mike

Per Jessen said:
Hi

I cleaned up your code and removed all Select statements as they are not
needed, only slowing the macro down.
Also inserted missing county numbers in column a, an added zero values in
column B:H.

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Delete Shift:=xlToLeft

' Center titles horizontally & vertically (format)
With Rows("1:1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
' End formatting
End With

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").SpecialCells(xlCellTypeBlanks).Delete

'Insert missing county's
rw = 3 'First County row
If Range("A" & rw).Value <> 1 Then
Rows(rw).EntireRow.Insert
Range("A" & rw) = 1
Range("B" & rw & ":H" & rw) = 0
End If
rw = rw + 1
County = 1
Do
If Cells(rw, "A").Value <> County + 1 Then
Rows(rw).EntireRow.Insert
Cells(rw, "A") = County + 1
Range("B" & rw & ":H" & rw) = 0
End If
County = County + 1
rw = rw + 1
Loop Until County = 67

' Select B70 thru G70
Range("B70:G70").FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
' Range("A1:A69").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Regards,
PEr

Accountant Mike said:
Florida has 67 counties. When I export data from an Acess database into an
Excel database, depending on the monthly report, not all 67 counties are
present. In order to work with the data in other reports, I need to make
sure
that column A (the county name/number) has all 67 numeric values.

I made a "clean-up" macro that cleans up all unnecessary info, formats,
and
inserts summation formulae where needed. My problem is I want it to also
enter missing county numbers (i.e. make certain 1 - 67 exist) and 0 in the
associated columns.

I'm including the macro here:

Sub ACCESS_IMPORT_CLEAN_UP()
'
' ACCESS_IMPORT_CLEAN_UP Macro
'

' Select top row
Range("B2:M2").Select

' Delete and shift up
Selection.Delete Shift:=xlUp

' Select first unnecessary column
Range("B2:B150").Select

' Delete and shift left
Selection.Delete Shift:=xlToLeft

' Select unnecessary columns: C,E,G,I,K
Range("C:C,E:E,G:G,I:I,K:K").Select

' Activate the range
Range("K1").Activate

' Delete the selection: C,E,G,I,K & shift to left
Selection.Delete Shift:=xlToLeft

' Scroll back to the left
ActiveWindow.ScrollColumn = 1

' Select All of row 1
Rows("1:1").Select

' Center titles horizontally & vertically (format)
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
' End formatting
End With

' Select Columns A thru G
Columns("A:G").Select

' Autofit the width of Columns A thru G
Columns("A:G").EntireColumn.AutoFit

' Select Cells A1 thru A150
Range("A1:A150").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete

' Scroll down to row 70
ActiveWindow.SmallScroll Down:=48

' Select B70 thru G70
Range("B70:G70").Select

' Sum cells 68 thru 1 in each column (B thru G)
Selection.FormulaR1C1 = "=SUM(R[-68]C:R[-1]C)"

' Select Cell A74
Range("A74").Select

' Write CHECKSUM in active cell (A74)
ActiveCell.FormulaR1C1 = "CHECKSUM:"

' Select Cell (G74)
Range("G74").Select

' Sum cells: Row 4 up , columns left 4 to left 1
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C[-5]:R[-4]C[-1])"

' Select Cells A1 thru A69
Range("A1:A69").Select

' Select (Special) blank cells in first (A) column
Selection.SpecialCells(xlCellTypeBlanks).Select

' Delete sheet rows (all rows that are blank in Column A)
Selection.EntireRow.Delete


End Sub


Any help will be appreciated!!

Accountant Mike
Click to expand...

.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Different Results from the Same Macro 3
Delete Rows and Sheets 3
Advice on multiple macros, same code just a different column 9
Copying Data Down the Column But Only Based on What's in Column A 3
Problems with a Run-time error of 1004.... 7
Macro Needed 1
Speeding up a delete rows Macro 7
Range issue 3

Top