Mississippi Girl
Board Regular
- Joined
- Oct 27, 2005
- Messages
- 155
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!!
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!!
Code:
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