I have a function, I would like it to subtract dates from me and create a new column. However, it does not work, it shows me an error here
.Value = Evaluate("if({1}," & .Offset(, -2).Address & "-" & .Offset(, -1).Address & ","""")")
Set shtResult = Sheets.Add.Name = "NPE"
But not help. Below is my code :
With wbMe.Sheets("NPE").Range("G2", Range("A" & Rows.Count).End(xlUp).Offset(, 1))
.Value = Evaluate("if({1}," & .Offset(, -2).Address & "-" & .Offset(, -1).Address & ","""")")
End With
Solution for above:
With wbMe.Sheets("Arkusz3").Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row)
.Value = .worksheet.Evaluate("if({1}," & .Offset(, -3).Address & "-" & .Offset(, -2).Address & ","""")")
End With
Related
I am trying to import tasks from one sheet(WS) to the main tracker sheet (Sub Tasks),. The import sheet has milestones and then sub tasks within each Milestone.
My code imports the milestones then goes back and imports the sub tasks for each milestone. However, if the milestones being added have the same title as ones already in the Sub Task sheet, it will add the sub tasks to the inocrrect milestone. I am using Range.Find, i understand it would find the first match, which is not want i want all the time. So i want to add criteria in, so if a match if found, and the value in column H is equal to the value in the N9 in the worksheet, and then value in Sub Task Column I is equal to the value in value N10 in WS, then add.
If not, find next and test again. However, i cannot seem to get it to work.
UPDATED
If .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity Then
newdeliverablerow = (findactivityintasks.row)
Else
Do
Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).FindNext(findactivityintasks)
Loop Until .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity
newdeliverablerow = (findactivityintasks.row)
End If
ALL CODE FOR SUB
'Add Milestone to subtask sheets
For Each cell In ImportWs.Range("B" & activityStart & ":B" & activityend)
NewRowSubTasks = lastrowsubtasks + i
DeliverableActivity = Int(cell.Offset(0, -1).Value)
With subtaskws
.Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Interior.ColorIndex = 16
.Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.ColorIndex = 2
.Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.Size = 12
.Range(IDCol & NewRowSubTasks).Interior.ColorIndex = 23
.Range(IDCol & NewRowSubTasks).Font.ColorIndex = 2
.Range(IDCol & NewRowSubTasks).Font.Size = 16
.Range(IDCol & NewRowSubTasks).NumberFormat = "0"
.Cells(NewRowSubTasks, SubTaskCol).Value = ImportWs.Range("B" & cell.row).Value
.Cells(NewRowSubTasks, IDCol).Value = Application.WorksheetFunction.RoundUp((subtaskws.Range("A" & NewRowSubTasks - 1).Value + 0.01), 0)
.Cells(NewRowSubTasks, TDSNumCol).Value = ImportWs.Range("N9").Value
.Cells(NewRowSubTasks, MileStoneNumCol).Value = DeliverableActivity
.Cells(NewRowSubTasks, BWLCol).Value = ImportWs.Range("L" & cell.row).Value
End With
i = i + 1
Next cell
'find start and end of deliverables
DeliverableStart = valuePos(ImportWs, "C:G", "Outputs / Deliverables") + 1
DeliverableEnd = valuePos(ImportWs, "A:G", "Tools / constraints") - 1
'find deliverables to add to Milestones and find what Milestones to add them too
For Each cell In ImportWs.Range("C" & DeliverableStart & ":C" & DeliverableEnd)
DeliverableActivity = Int(cell.Offset(0, -1).Value)
Set finddeliverableactivity = ImportWs.Range("A" & activityStart & ":A" & activityend).Find(What:=("# " & (DeliverableActivity + 1)), Lookat:=xlWhole)
If finddeliverableactivity Is Nothing Then
With subtaskws
Dim lastrowsubtasks1 As Long
lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
newdeliverablerow = (lastrowsubtasks1 + 1)
.Range("A" & (newdeliverablerow)).EntireRow.Insert
newrow = newdeliverablerow
.Range("A4").EntireRow.Copy
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
.Range("A" & newrow & ":AE" & newrow & "").ClearContents
.Columns("A:BB").Calculate
.Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
.Cells(newrow, SubTaskCol).Value = cell.Value
.Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
.Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
.Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
.Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
.Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
.Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
.Range("A" & newrow).EntireRow.Hidden = False
End With
Exit Sub
Else
With subtaskws
lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
activityrow = finddeliverableactivity.row
ActivtiyforDeliverable = ImportWs.Range("B" & activityrow).Value
Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).Find(What:=(ActivtiyforDeliverable), Lookat:=xlWhole)
newdeliverablerow = (findactivityintasks.row)
.Range("A" & (newdeliverablerow)).EntireRow.Insert
newrow = newdeliverablerow
.Range("A4").EntireRow.Copy
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
.Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
.Range("A" & newrow & ":AE" & newrow & "").ClearContents
.Columns("A:BB").Calculate
.Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
.Cells(newrow, SubTaskCol).Value = cell.Value
.Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
.Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
.Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
.Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
.Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
.Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
.Range("A" & newrow).EntireRow.Hidden = False
End With
End If
Next cell
Call CompactView
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
I am trying to update a previous employees code.
Column D and E are not adding the correct sub-totals. It seems for each sub total row, it is counting A4 which is the first row of numbers.
Not sure how to adjust the code.
Set firstSub = Range("D" & cTL.Row) 'set first sum from
For Each c In Range("D" & cTL.Row, "D" & cBR.Row)
If c.Value2 = "" Then
c.ClearContents
End If
'This if will only run for column D, but will fill column D and E with total fields
If Right(c.Offset(0, -2).Value2, Len(sTotal)) = sTotal Then
c.FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Column & ")"
c.Offset(0, 1).FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Offset(0, 1).Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Offset(0, 1).Column & ")"
formulaStrD = formulaStrD & c.Address([], [], xlR1C1) & ","
formulaStrE = formulaStrD & c.Offset(0, 1).Address([], [], xlR1C1) & ","
ElseIf Right(Range("A" & c.Row), Len(sTotal)) = sTotal Then
formulaStrD = Left(formulaStrD, Len(formulaStrD) - 1)
formulaStrE = Left(formulaStrE, Len(formulaStrE) - 1)
c.FormulaR1C1 = "=SUM(" & formulaStrD & ")"
c.Offset(0, 1).FormulaR1C1 = "=SUM(" & formulaStrE & ")"
End If
Next c
For Each c In Range("E" & cTL.Row, "H" & cBR.Row)
If c.Value2 = "" Then
c.ClearContents
End If
Next c
End Function
The key to fixing this (I think) is to 'reset' the "first row" each time the value in column B changes - otherwise, each sub-total for each distinct value in column B will reflect the aggregate of all rows above it - including the other sub-totals.
Set firstSub = Range("D" & cTL.Row) 'set first sum from
For Each c In Range("D" & cTL.Row, "D" & cBR.Row)
If c.Value2 = "" Then
c.ClearContents
End If
'This if will only run for column D, but will fill column D and E with total fields
If Right(c.Offset(0, -2).Value2, Len(sTotal)) = sTotal Then
c.FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Column & ")"
c.Offset(0, 1).FormulaR1C1 = "=sum(R" & firstSub.Row & "C" & c.Offset(0, 1).Column & ":R" & c.Offset(-1, 0).Row & "C" & c.Offset(0, 1).Column & ")"
formulaStrD = formulaStrD & c.Address([], [], xlR1C1) & ","
' Fix the Column E subtotal reference
formulaStrE = formulaStrE & c.Offset(0, 1).Address([], [], xlR1C1) & ","
' Reset the "firstRow" so that we don't accidentally pickup
' the other subtotals
Set firstSub = c.Offset(1, 0)
ElseIf Right(Range("A" & c.Row), Len(sTotal)) = sTotal Then
formulaStrD = Left(formulaStrD, Len(formulaStrD) - 1)
formulaStrE = Left(formulaStrE, Len(formulaStrE) - 1)
c.FormulaR1C1 = "=SUM(" & formulaStrD & ")"
c.Offset(0, 1).FormulaR1C1 = "=SUM(" & formulaStrE & ")"
' Reset the subtotal formulas along with the "firstRow"
formulaStrD = ""
formulaStrD = ""
Set firstSub = c.Offset(1, 0)
End If
Next c
For Each c In Range("E" & cTL.Row, "H" & cBR.Row)
If c.Value2 = "" Then
c.ClearContents
End If
Next c
I have a problem with my code, here it is:
Sheets("Data - Backtest").Cells(5, linCompteur - 1).FormulaR1C1 = _
"=BDH(R[-3]C[1],""PX_LAST"",""ED-"" & " & .Cells(6, 5).Value & " & ""AYA""," & .Cells(7, 5).Value & ", **""per="" & " & .Cells(9, 6).Value & "** , **""fx="" & " & .Cells(8, 5).Value & "** ,""Days=W"",""Fill=P"",""cols=2"")"
In the Excel it gives this,
=BDH(R[-3]C[1];"PX_LAST";"ED-" & 5 & "AYA";; **"per=" & d**; **"fx=" & EUR**;"Days=W";"Fill=P";"cols=2")
I see where is the problem, it's d and EUR, it should be this:
=BDH(R[-3]C[1];"PX_LAST";"ED-" & 5 & "AYA";;**"per=" & "d"**;**"fx=" & "EUR"**;"Days=W";"Fill=P";"cols=2";"cols=2;rows=1305")
but I don't know how to do this for the equivalent in VBA.
I brought some of the string concatenations together where there didn't seem any reason to separate them.
workSheets("Data - Backtest").Cells(5, linCompteur - 1).FormulaR1C1 = _
"=BDH(R[-3]C[1], ""PX_LAST"", ""ED-" & .Cells(6, 5).Value & "AYA"", " & .Cells(7, 5).Value & ", ""per=" & .Cells(9, 6).Value & """ , ""fx=" & .Cells(8, 5).Value & """ , ""Days=W"", ""Fill=P"", ""cols=2"")"
This is the result on the worksheet.
=BDH(R[-3]C[1], "PX_LAST", "ED-5AYA", , "per=d" , "fx=EUR" , "Days=W", "Fill=P", "cols=2")
I am trying to build a macro to copy paste specific columns from rows, when an If condition is satisfied. The part of the If condition is tested and working, as I have used it in another macro. The problem in my case is that I dont know how to select specific columns of a row inside a loop. I only know how to select the entire row (in this case it would have been rows(i).EntireRow.Copy if I am not mistaken). I am providing my code below. The part that needs editing is the
.Rows(i).Columns(1, 4, 6, 8).Copy
Sheets("WFRandVFR_REPORT").range("W2").Paste
The entire code is this one
(UPDATED VERSION)
I am providing the screenshots too
Dim lr As Long
Dim rng As range
Dim mDiff1 As Double
mDiff1 = 0.01
With Worksheets("WFRandVFR_REPORT")
lr = range("L" & Rows.Count).End(xlUp).Row
For i = 2 To lr
If Cells(i, "U").Value - Cells(i, "V").Value > mDiff1 Then
If rng Is Nothing Then
Set rng = .range("L" & i & ":V" & i)
Else
Set rng = Union(rng, .range("L" & i & ":V" & i))
End If
End If
Next i
rng.Copy
Sheets("WFRandVFR_REPORT").range("AI2").PasteSpecial
End With
To copy you may use
Range("A" & i & ", D" & i & ", F" & i & ", H" & i & "").Copy '(as mentioned in comment)
or
Union(.Range("A" & i), .Range("D" & i), .Range("F" & i), .Range("H" & i)).Copy
Thus, try
Union(.Range("A" & i), .Range("D" & i), .Range("F" & i), .Range("H" & i)).Copy
Sheets("WFRandVFR_REPORT").range("W2").PasteSpecial xlPasteValues
or just
Union(.Range("A" & i), .Range("D" & i), .Range("F" & i), .Range("H" & i)).Copy
Sheets("WFRandVFR_REPORT").range("W2").PasteSpecial
or
Union(.Range("A" & i), .Range("D" & i), .Range("F" & i), .Range("H" & i)).Copy Sheets("WFRandVFR_REPORT").range("W2")
EDIT :
Is there any specific reason why you are looping from bottom to up, if not change FOR loop as
For i = 2 To lastrow
Your code will be
Dim mDiff As Integer
Dim rng As Range
mDiff = 0.03
With Worksheets("WFRandVFR_REPORT")
lastrow = Range("L" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, "U").Value - Cells(i, "V").Value > mDiff Then
If rng Is Nothing Then
Set rng = .Range("L" & i & ":V" & i)
Else
Set rng = Union(rng, .Range("L" & i & ":V" & i))
End If
End If
Next i
rng.Copy
Sheets("WFRandVFR_REPORT").Range("AI2").PasteSpecial
End With
I am trying to use .formulaR1C1 to sum up values from different sheets on my main sheet for my workbook.
Everytime I run through my code it errors on the last bit where the formula is entered.
code:
For cRow = 9 To row
For Each WS In Worksheets
If Left(WS.Name, 5) <> "Total" Then
If Left(WS.Name, InStr(WS.Name, " ") - 1) = "December" Then
ytdSheet.Cells(cRow, 2).FormulaR1C1 = "=SUM(" & ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!RC)" 'HERE IS WHERE ERROR OCCURS!!!
Else
ytdSheet.Cells(cRow, 2).Value = ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!RC,"
End If
End If
Next WS
Next cRow
I feel like I am missing something simple, but I cannot figure it out.
Well I figured out why it wasn't working! my code was putting in a leading ' but in the cell, it reads it as a "Make this a text entry" so it doesn't show up in the debug.print ..
I changed my code to use an array instead of the cell to hold the string while I build it, and then use the formulaR1C1 line to output to the cell..
For cRow = 9 To row
For Each WS In Worksheets
If Left(WS.Name, 5) <> "Total" Then
If Left(WS.Name, InStr(WS.Name, " ") - 1) = "December" Then
ytdSheet.Cells(cRow, 2).FormulaR1C1 = "=sum(" & sArr(1) & "'" & WS.Name & "'!R" & cRow & "C2)" 'HERE!!!
'Debug.Print "=" & ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!R" & cRow & "C2" 'HERE!!!
Else
sArr(1) = sArr(1) & "'" & WS.Name & "'!R" & cRow & "C2, "
Debug.Print sArr(1)
End If
End If
Next WS
Next cRow
works like a charm!