Help Cleaning Up Code / Macro

[Mississippi Girl]

I have this huge code that started off as a macro, then was combined with other macros and bits of coded gleaned from the board (see posts under "Help with Monster Macro - Auto Fill" to see the initial q&a). Everything works perfectly, but I know there is a more efficient way of writing this...I just don't know how to do it.

The code is below. Bascially what I am doing is downloading data from two separate sources into two worksheets in the same workbook, normalizing the data in the worksheets, then copying the data from both normalized sheets into one sheet which is later uploaded to a database. If anyone has any input, I'd really appreciate it....I know there are a lot of "select" and other things that can be simplfied, but I'm not a VB expert. Everything I know came from this board.

Thanks!!

Sub Test()
Dim Limit As Long, c As Long
Dim r As Range
 
Sheets("CS ODIN Upload").Select
Cells.Select
Selection.ClearContents
 
Sheets("BW Download").Select
Rows("1:37").Delete Shift:=xlUp
 
With Rows(1)
.Replace What:="*Overall Result*", Replacement:="", LookAt:=xlPart
.SpecialCells(4).EntireColumn.Delete
End With
 
With Sheets("BW Download")
Limit = .UsedRange.Rows.Count
.Columns("A:D").Insert Shift:=xlToRight
Range("A1") = "Check"
Range("B1") = "Benefitor"
Range("C1") = "ODIN Benefitor"
Range("D1") = "Work Group"
 
For Each r In .Range("B2:B" & Limit)
r.FormulaR1C1 = "=VLOOKUP(RC[3],BLT!BLT,2)"
Next r
For Each r In .Range("C2:C" & Limit)
r.FormulaR1C1 = "=LEFT(RC[-1],2)&IF(MID(RC[-1],3,1)>""1"",""81"",""11"")"
Next r
For Each r In .Range("A2:A" & Limit)
r.FormulaR1C1 = "=IF(VLOOKUP(RC[4],BLT!BLT,1)=RC[4],""True"",""False"")"
Next r
For Each r In .Range("D2:D" & Limit)
r.Value = "GHOST"
 
Range("G1") = "OCT"
Range("H1") = "NOV"
Range("I1") = "DEC"
Range("J1") = "JAN"
Range("K1") = "FEB"
Range("L1") = "MAR"
Range("M1") = "APR"
Range("N1") = "MAY"
Range("O1") = "JUN"
Range("P1") = "JUL"
Range("Q1") = "AUG"
Range("R1") = "SEP"
 
Next r
.Range("a:a").AutoFilter Field:=1, Criteria1:="True"
.Range("b:d,g:r").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("CS ODIN Upload").Range("A1")
 
.Range("a:a").AutoFilter Field:=1, Criteria1:="False"
.Range("d:r").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Fallout").Range("A1")
 
Selection.AutoFilter Field:=1
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("CS ODIN Upload").Select
Range("A1").Select
Sheets("CT ODIN Upload").Select
Cells.Select
Selection.ClearContents
Sheets("CDW Download").Select
Range("A1").Select
 
Rows("1:2").Select
Selection.Delete Shift:=xlUp
 
Dim lastrow As Long, i As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
 
With ws
On Error Resume Next
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = lastrow To 1 Step -1
If .Range("A" & i).Value = 0 Or .Range("D" & i).Value = "N/A" Then .Rows(i).Delete
Next i
End With
 
Next ws
Columns("A:B").Select
Selection.Insert Shift:=x1Right
Range("A1") = "Benefitor"
Range("B1") = "ODIN Benefitor"
 
Range("A2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[2],4)"
Selection.AutoFill Destination:=Range("A2:A" & Range("d" & Rows.Count).End(xlUp).Row)
 
Range("B2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)&IF(MID(RC[-1],3,1)>""1"",""81"",""11"")"
Selection.AutoFill Destination:=Range("b2:B" & Range("d" & Rows.Count).End(xlUp).Row)
 
Columns("D:D").Select
Selection.Delete Shift:=x1Left
 
Range("D1").Select
Range("D1") = "Work Group"
 
With Rows(1)
.Replace What:="*Total*", Replacement:="", LookAt:=xlPart
.SpecialCells(4).EntireColumn.Delete
End With
 
Range("a:b,d:p").Copy Destination:=Sheets("CT ODIN Upload").Range("A1")
 
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("CT ODIN Upload").Select
Range("A1").Select
Sheets("Monthly Hours").Select
Cells.Select
Selection.Delete Shift:=xlUp
 
Sheets("CS ODIN Upload").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("Monthly Hours").Select
Range("A1").Select
ActiveSheet.Paste
 
Sheets("CT ODIN Upload").Select
Range(("A2"), ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Monthly Hours").Select
Range("A1").End(xlDown).Select
ActiveSheet.Paste
 
Range("A1").CurrentRegion.Select
Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub

 

[Norie]

Well I'm not going to fully deconstruct your code.

But one thing that immediately sticks out is this.

For Each r In .Range("D2:D" & Limit)
r.Value = "GHOST"
 
Range("G1") = "OCT"
Range("H1") = "NOV"
Range("I1") = "DEC"
Range("J1") = "JAN"
Range("K1") = "FEB"
Range("L1") = "MAR"
Range("M1") = "APR"
Range("N1") = "MAY"
Range("O1") = "JUN"
Range("P1") = "JUL"
Range("Q1") = "AUG"
Range("R1") = "SEP"
 
Next r

Why are you looping when you could just use this?

.Range("D2:D" & Limit) = "GHOST"
 .Range("G1:R1") = Array("OCT", "NOV", "DEC", "JAN","FEB", "MAR", "APR", "MAY","JUN", "JUL", "AUG", "SEP")

I also recommend that you look into the various posts on the site that explain why there is no need to use Select.

Next r

 

[Mississippi Girl]

Beautiful Norie!! Thanks...I can tell you exactly why I'm looping -- because I have no clue what I'm doing!

I did try to limit some of the "selects" before I posted, for example, the very beginning where it says

Sheets("CS ODIN Upload").Select
Cells.Select
Selection.ClearContents
 
Sheets("BW Download").Select
Rows("1:37").Delete Shift:=xlUp

I tried replacing that with

    Sheets("CS ODIN Upload").Cells.ClearContents
    Sheets("BW Download").Rows("1:37").Delete Shift:=xlUp

but kept getting a run time error 9 - subscript out of range. Not sure why though.

Thanks again for your help. Just that small change will probably make a huge difference in performance.

 

[Mississippi Girl]

Okay, I am too embarressed to even mention why I was getting the run time error I stated earlier ...but, I am glad to say that I have cleaned up a lot based on the info that Norie provided. There is one last area that I do not think I can handle on my own...

 Sheets("CS ODIN Upload").Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Monthly Hours").Select
    Range("A1").Select
    ActiveSheet.Paste
 
    Sheets("CT ODIN Upload").Select
    Range(("A2"), ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Monthly Hours").Select
    Range("A1").End(xlDown).Select
    ActiveSheet.Paste
 
    Range("A1").CurrentRegion.Select
    Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

How do you simplify this?? Oh, the sheets named "CS ODIN Upload" and "CT ODIN Upload" are hidden...so, getting rid of the selects would be most excellent.

Thanks again.

 

[Norie]

Perhaps something like this, for a start anyway.

Sheets("CS ODIN Upload").Range("A1").CurrentRegion.Copy Sheets("Monthly Hours").Range("A1")

 

[Mississippi Girl]

Thanks Norie. The code works, but am wondering how I would do the same thing for the CT ODIN Upload sheet, only beginning the copy at A2 instead of A1.

I tried doing this:

Sheets("CT ODIN Upload").Range("A2").CurrentRegion.Copy Sheets("Monthly Hours").Range("A2").End(xlDown)

but that still picks up the first row of data in the CT ODIN Upload sheet.

Any ideas?

Thanks.

 

[Mississippi Girl]

If the CT ODIN Upload sheet is hidden, this code doesn't work. I'm guessing this is because of the "select" statement.

Is there a way to write this without the select and keep the same functionality? (copying the data beginning at A2, copying all the data, and pasting the data to the first empty row on the "Monthly Hours" worksheet)

I really need to be able to hide the CT ODIN Upload worksheet. Any help is greatly appreciated.

Thanks!

    Sheets("CT ODIN Upload").Select
    Range(("A2"), ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Monthly Hours").Select
    Range("A1").End(xlDown).Select
    ActiveSheet.Paste

 

[Norie]

Is there a big problem with the first row being picked up?

That could easily be dealt with.

 

[Mississippi Girl]

The first row contains the headings that are already in place on the destination sheet. I could change an earlier part of the code to delete that row, that would solve at least part of the problem....