Hey guys. I have a code that is working perfectly, thanks in a large part to folks here, however, I don't completely understand how every aspect of it works, which is giving me trouble customizing it a little further. I have attached the two files I am working with and below is the code that is stored in my personal file to run as a macro. To give a basic idea of what the code does, it takes invoice numbers from the two files and compares them to each other, if the invoice number exists on both documents, it copies additional information from both. One contains hours worked on a job, and one contains the total cost of the job. This information is created in a new workbook with a calculation for the cost per hour and saved wherever the user wants, a few clean up tasks run and it's done. What I am trying to add, is associated with each of these jobs is a REP code to tell us, who bid the work. I'm trying to figure out how to make it copy this information as well and paste it in the 5th column of the new worksheet. From there I want it to average out the cost per hour, per bidder and display that information to the right of the of the spreadsheet, a few columns over from the information, somewhere near the top. Any help would be REALLY appreciated, this project is so close to done. I'm going to keep playing with it and I'll post any progress here! Thanks again!
Sub CreateWorkbooksV2()
Application.ScreenUpdating = False
Workbooks("Timeclock Output.xlsx").Activate
Dim timecodeSheet As Worksheet
Set timecodeSheet = Sheets("Sheet1")
Dim Bot As Integer ' May have to change this if the last row gets too big
Bot = timecodeSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Add the formulas
Range(Cells(4, 8), Cells(Bot, 8)).FormulaR1C1 = "=IF(SUMIF('[QB Output.xlsx]Sheet1'!C4,RC3,'[QB Output.xlsx]Sheet1'!C6)=0,"""",SUMIF('[QB Output.xlsx]Sheet1'!C4,RC3,'[QB Output.xlsx]Sheet1'!C6))"
Dim newSheet As Worksheet
Sheets.Add After:=Sheets(Sheets.Count)
Set newSheet = ActiveSheet
timecodeSheet.Range("C:C").Copy Destination:=newSheet.Cells(1, 1) ' Done twice because of merged cells
timecodeSheet.Range("G:G").Copy Destination:=newSheet.Cells(1, 2)
timecodeSheet.Range("H:H").Copy Destination:=newSheet.Cells(1, 3) ' Done a third time for the new formula columns
For i = Bot To 2 Step -1 ' Start from the last row and go up
If Cells(i, 1) = "?" Or Cells(i, 1) = vbNullString Or Cells(i, 1) = "Level 3" Or Cells(i, 1) = "" Or UCase(Trim(Right(Cells(i, 1), 5))) = "TOTAL" Then Rows(i).Delete Shift:=xlUp ' If the first cell of row is ?, empty, or Level 3 delete the row
Next
'NAME THE NEW SHEET TO BE SAVED
ActiveSheet.Name = "Summary"
'SET THE TITLES
Range("A1") = "Invoice"
Range("A1").Font.Bold = True
Range("A1").Font.Color = vbRed
Range("A1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Range("B1") = "Hours"
Range("B1").Font.Bold = True
Range("B1").Font.Color = vbRed
Range("B1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Range("C1") = "Cost"
Range("C1").Font.Bold = True
Range("C1").Font.Color = vbRed
Range("C1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Range("D1") = "$/HR"
Range("D1").Font.Bold = True
Range("D1").Font.Color = vbRed
Range("D1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
'TURN FORMULAS INTO VALUES
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'PASTE COST PER HOUR FORMULA
Dim lrow As Long
Dim r As Range
lrow = Cells(Rows.Count, 3).End(xlUp).Row + 1
For Each r In Range("C2:C" & lrow)
If r.Value <> vbNullString Then
r.Offset(0, 1).FormulaR1C1 = "=IF(RC[-2]=0,"""",ROUND(RC[-1]/(RC[-2]*24),2))"
End If
Next
'ADJUST COLUMN WIDTH
Columns("A:A").ColumnWidth = 12.7
'CREATE NEW WORK BOOK/FILE SAVE
Sheets("Summary").Copy
Dim wb As Workbook
Set wb = ActiveWorkbook
Do
fName = Application.GetSaveAsFilename
Loop Until fName <> False
wb.SaveAs Filename:=fName & "xlsx", FileFormat:=xlWorkbookDefault
'DELTE UNNECESARY DATA
Application.DisplayAlerts = False
Workbooks("Timeclock Output.xlsx").Activate
Sheets("Summary").Delete
Columns("H:H").Select
Selection.ClearContents
'CLOSE WORKBOOKS
ActiveWorkbook.Close False
Workbooks("QB Output.xlsx").Activate
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bookmarks