I have a data issue that has been perplexing me for a few weeks now.
Goal:
- Sum set range into new reference cell. Perform this for 8 different ranges spanning 42 columns. This needs to be performed on a row by row basis so each entry has their appropriate numbers.
- Columns L:S should only have a value if the SUM range itself had any values. No false 0's.
Issues:
- The SUM Function works, but it is returning a 0 in situations when there were no values to Sum. This is an issue as 0 is a valid value, and the extra 0's throw off averages of those who actually have values.
- SUMIFS is returning TRUE instead of a value (I use SUMIFS with 1 criteria as it is easier for me to understand, don't focus on that bit as it did the same thing when I had it in the SUMIF formula).
Here is my VBA in it's entirety:
Sub BE_Candidate_Flow_Time()
'
' BE_Candidate_Flow_Time Macro
'
Dim StartCell As Range
Dim RangeName As String
Dim myValue As Variant
Set StartCell = Range("A1")
myValue = InputBox("Enter Date: YY-MMM")
StartCell.CurrentRegion.Select
RangeName = "Dataset"
Dim LRow As Long
Dim lCol As Long
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("J:Q").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "Application ID"
Range("B1").FormulaR1C1 = "Timeframe"
Range("K1").FormulaR1C1 = "Job Code"
Range("L1").FormulaR1C1 = "Time to Complete the Assessment"
Range("M1").FormulaR1C1 = "Applied/Assessed and Ready for Review"
Range("N1").FormulaR1C1 = "Time being Reviewed and Interviewed"
Range("O1").FormulaR1C1 = "Time to Accept the Offer"
Range("P1").FormulaR1C1 = "Consent to Pre-Hire Screenings"
Range("Q1").FormulaR1C1 = "Run the Pre-Hire Screenings"
Range("R1").FormulaR1C1 = "Waiting to be sent to Onboard"
Range("S1").FormulaR1C1 = "In Onboard"
Range("A2", "A" & LRow).FormulaR1C1 = "=CONCATENATE(RC[2],RC[5])"
Range("B2", "B" & LRow).Value = myValue
Columns("T:BI").NumberFormat = "0.00"
Range("L2", "L" & LRow).FormulaR1C1 = "=SUMIFS({RC[9];RC[13]},{RC[9];RC[13]}," <> ")"
Range("M2", "M" & LRow).FormulaR1C1 = "=SUMIFS({RC[7];RC[9]:RC[11];RC[13]:RC[16]},{RC[7];RC[9]:RC[11];RC[13]:RC[16]}," <> ")"
Range("N2", "N" & LRow).FormulaR1C1 = "=SUMIFS({RC[16]:RC[27]},{RC[16]:RC[27]}," <> ")"
Range("O2", "O" & LRow).FormulaR1C1 = "=SUMIFS({RC[27]:RC[31];RC[33]:RC[34]},{RC[27]:RC[31];RC[33]:RC[34]}," <> ")"
Range("P2", "P" & LRow).FormulaR1C1 = "=SUMIFS({RC[34]},{RC[34]}," <> ")"
Range("Q2", "Q" & LRow).FormulaR1C1 = "=SUMIFS({RC[35]:RC[40]},{RC[35]:RC[40]}," <> ")"
Range("R2", "R" & LRow).FormulaR1C1 = "=SUMIFS({RC[40]:RC[41]},{RC[40]:RC[41]}," <> ")"
Range("S2", "S" & LRow).FormulaR1C1 = "=SUMIFS({RC[41]:RC[42]},{RC[41]:RC[42]}," <> ")"
Range("K1", "K" & LRow).AutoFilter 1, ""
Range("K2", "K" & LRow).FormulaR1C1 = "=RC[-1]"
[K1].AutoFilter
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("J:J,T:BI").Delete Shift:=xlToLeft
Range("A1").Select
End Sub
You could add a if to the formula directly.
Somthing like
=IF(
count({RC[7];RC[9]:RC[11];RC[13]:RC[16]})>0;
SUM({RC[7];RC[9]:RC[11];RC[13]:RC[16]};
""
)
Related
This is my first time asking a question on here. I have dug through similar questions, but have had no luck yet in resolving this quandary. I appreciate any help you can give me.
In the data set I am working with, I am looking to delete any rows that contain the word "Bench" in column R. I already have the rest of the worksheet running and have the Lrow value set as the last row.
I was first successful using the .Setfilter, selecting the range, and using EntireRow.Delete. But this ended up deleting the entire dataset if there were no rows to select.
To summarize the ask: Looking in Range("R2":"R" & Lrow), find all cells containing the text "Bench", then Delete the row.
Thank you!
Here is the entire VBA as sits right now (this bit is near the bottom):
Sub BE_Time_to_Fill()
'
' BE_Time_to_Fill Macro
'
Dim StartCell As Range
Dim RangeName As String
Dim myValue As Variant
Set StartCell = Range("A1")
myValue = InputBox("Enter Date: YY-MMM")
'Select Range
StartCell.CurrentRegion.Select
RangeName = "Dataset"
Dim LRow As Long
Dim lCol As Long
'Find the last non-blank cell in column A(1)
LRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").FormulaR1C1 = "Time to Fill"
Range("J2", "J" & LRow).FormulaR1C1 = "=RC[1]+RC[2]"
Range("F1").Select
Range("F1").FormulaR1C1 = "Job Code"
Range("F1", "F" & LRow).AutoFilter 1, ""
Range("F2", "F" & LRow).FormulaR1C1 = "=RC[-1]"
[F1].AutoFilter
Range("M1").FormulaR1C1 = "Source Time"
Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").FormulaR1C1 = "Cycle Time"
Range("N2", "N" & LRow).FormulaR1C1 = "=IMSUB(RC[1],RC[-1])"
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "Application ID"
Range("A2", "A" & LRow).FormulaR1C1 = "=CONCATENATE(RC[1],RC[4])"
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").FormulaR1C1 = "Timeframe"
Range("B2", "B" & LRow).Value = myValue
Dim rng As Range
Dim DelRng As Range
Set DelRng = Range("R2:R" & LRow)
For Each rng In DelRng
If rng.Value = "*Bench" Then
rng.EntireRow.Delete
ElseIf rng.Value <> "*Bench" Then
End If
Next
Range("G:H,M:N").Delete Shift:=xlToLeft
Range("A1").Select
End Sub
Without seeing what code you have we can't help update it. But from your question the below might help.
If you're using a loop you'll need to include what to do if the set conditions aren't met. See example:
Sub example()
Dim rng As Range, DelRng As Range
Dim LastRow As Long
LRow = Range("R" & Rows.Count).End(xlUp).Row 'test for last filled row in column R
Set DelRng = Range("R1:R" & LRow) 'sets your range
For Each rng In DelRng
'change this value to match whatever you want to find. make sure this is entered as ALL CAPS and without spaces
If UCase(WorksheetFunction.Substitute(rng.Value, " ", "")) = "GEM/BENCH" Then
rng.EntireRow.Delete
ElseIf UCase(WorksheetFunction.Substitute(rng.Value, " ", "")) <> "GEM/BENCH" Then 'if loop can't find anything it will just exit
End If
Next
End Sub
I have been working on some code that goes through and tries to find "New Muted Price" or "New Opposed Price". If that is not found during the array iteration, it comes up with a
Mismatch error run code 13
I know this is because it did not find it, but how do I just get it to skip past the error and continue with the code? I have tried
if not iserror (PriceCol = Application.Match("New Opposed Price", rng, 0)) then but it is still showing the mismatch error.
The portions of the code where the error comes up is:
PriceCol = Application.Match("New Opposed Price", rng, 0)
and
pricecol2 = Application.Match("New Muted Price", rng, 0)
Does anyone have some advise on how to resolve this issue?
Sub WIP()
Dim wb As Workbook
Dim wsMain As Worksheet
Dim wsLookup As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim rFind1 As Range
Dim rFind2 As Range
Dim rFind3 As Range
Dim MyArray As Variant
Dim LookupHeaders As Variant
Dim LookupHeaders2 As Variant
Dim LR As Long
Dim i As Long
Dim PriceCol As Long
Dim pricecol2 As Long
Dim LastColumn As Long
Dim LastColumn2 As Long
Dim LastColumn3 As Long
Dim LastColumn4 As Long
Dim IndexCol As Long
'Unformatted Price Row
Sheets("Consolidate List").Select
LR = Range("A" & Rows.Count).End(xlUp).Row
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("J:N").Delete
Columns("J:J").Select
ActiveWindow.FreezePanes = True
Range("H2").Select
ActiveCell.FormulaR1C1 = "New Price"
ActiveCell.Interior.ColorIndex = 22
Range("H3:H" & LR).Formula = "=VLOOKUP(RC[-7],'Connect Report'!C[-7]:C[-6],2,FALSE)"
ActiveCell.EntireColumn.Resize(Rows.Count - 2).Offset(2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I2").Select
ActiveCell.FormulaR1C1 = "Difference"
ActiveCell.Interior.ColorIndex = 22
Range("I3:I" & LR).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
ActiveCell.EntireColumn.Resize(Rows.Count - 2).Offset(2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set wb = ActiveWorkbook
Sheets("Consolidate List").Select
Set wsMain = wb.ActiveSheet
Set wsLookup = wb.Sheets("Connect Report") '<-- Change to correct sheet name for the Lookup sheet
LR = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
MyArray = Array("US", "SPAIN", "California")
LookupHeaders = Array("TTIER", "Time333", "Round6")
LookupHeaders2 = Array("TELLER5", "Fly7", "Mine4")
For i = LBound(MyArray) To UBound(MyArray)
With wsMain.Rows(1)
Set rFind1 = .Find(What:=MyArray(i), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind1 Is Nothing Then
Set rng = rFind1.Offset(1).Resize(, 8)
PriceCol = Application.Match("New Opposed Price", rng, 0)
LastColumn = rFind1.Column + PriceCol
If wsMain.Cells(rng.Row, LastColumn) <> "New Opposed Price" Then
wsMain.Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng.Row, LastColumn).Value = "New Opposed Price"
wsMain.Cells(rng.Row, LastColumn).Interior.ColorIndex = 22
LastColumn2 = LastColumn + 1
wsMain.Columns(LastColumn2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng.Row, LastColumn2).Value = "Difference"
wsMain.Cells(rng.Row, LastColumn2).Interior.ColorIndex = 22
Set rFind2 = wsLookup.Rows(1).Find(LookupHeaders(i), wsLookup.Range("A1"), xlValues, xlWhole)
If Not rFind2 Is Nothing Then
IndexCol = rFind2.Column
wsMain.Cells(rng.Row + 1, LastColumn).Resize(LR - 2).Formula = "=VLOOKUP(A" & rng.Row + 1 & ",'Connect Report'!$A:$AL," & IndexCol & ",FALSE)"
wsMain.Cells(rng.Row + 1, LastColumn2).Resize(LR - 2).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
Else
MsgBox "Excel could not find " & LookupHeaders(i) & " in the lookup table."
End If
Set rng2 = rFind1.Offset(1).Resize(, 8)
pricecol2 = Application.Match("New Muted Price", rng, 0)
LastColumn3 = rFind1.Column + pricecol2
If wsMain.Cells(rng.Row, LastColumn3) <> "New Muted Price" Then
wsMain.Columns(LastColumn3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng2.Row, LastColumn3).Value = "New Muted Price"
wsMain.Cells(rng2.Row, LastColumn3).Interior.ColorIndex = 22
LastColumn4 = LastColumn3 + 1
wsMain.Columns(LastColumn4).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng2.Row, LastColumn4).Value = "Difference"
wsMain.Cells(rng2.Row, LastColumn4).Interior.ColorIndex = 22
End If
Set rFind3 = wsLookup.Rows(1).Find(LookupHeaders2(i), wsLookup.Range("A1"), xlValues, xlWhole)
If Not rFind3 Is Nothing Then
IndexCol = rFind3.Column
wsMain.Cells(rng2.Row + 1, LastColumn3).Resize(LR - 2).Formula = "=VLOOKUP(A" & rng2.Row + 1 & ",'Connect Report'!$A:$AL," & IndexCol & ",FALSE)"
wsMain.Cells(rng2.Row + 1, LastColumn4).Resize(LR - 2).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
Else
MsgBox "Excel could not find " & LookupHeaders2(i) & " in the lookup table."
End If
End If
End If
End With
Next i
End Sub
You're on the right track using Application.Match (which can return an Error object) versus WorksheetFunction.Match (which always raises the error).
But since your PriceCol and PriceCol2 variables are strongly typed as Long, you'll get a Mismatch error.
Use another throwaway variable to handle the return:
Dim matchVal as Variant
matchVal = Application.Match("New Muted Price", rng, 0)
If Not IsError(matchVal) Then
PriceCol2 = matchVal
...
Else
' if there is no match, you may need to do something else here.
End If
Alternatively, you could use the Range.Find method:
If Not rng.Find("New Muted Price") Is Nothing
PriceCol2 = Application.Match("New Muted Price", rng, 0)
Else
...
I have written some Excel VBA to add weekday dates, down column "A", for 41 worksheets. The dates build to 90 days out and then have a "Beyond mm/dd/yy" text value in the following cell. The code is run every weekday, with the exception of holidays, and builds the dates over the cell that was previously the text cell. This process works beautifully, except for the first of 41 worksheets, where the added date(s) display as text, even though their "format" will say they are a date. The other 40 display as dates. I have attempted to wrap my calculated dates in CDate() and DateValue(), and both. The closes I came was copying down the above cell, but then I will get non-weekdays, as Excel builds the next autofill. I even tried to revisit the one worksheet with the issue and roll through the IF Then Else again, but, with a defined value for the "Beyond" text row and then reassign the dates - this yielded the same result; so, I have concluded that the issue is likely related to how I have written the IF Then Else portion.
Thank you for any ideas~
Dim count As Integer
Sheets("ABCD").Activate
For count = 1 To 41
'*************************************************************************** ********************
'Inserts Dates for weekdays, until 90 days out, then a "Beyond MM/DD/YY" value for the last date
'***********************************************************************************************
Dim ThisSheet As String
'turn off auto formula calculation
Application.Calculation = xlManual
Range("A1").Activate
'find the current "Beyond" date cell
Columns("A:A").Select
Selection.Find(What:="Beyond", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("A" & ActiveCell.Row).Select
'Add business days to column(A:A) until the next business day would be 91 days or greater
Do Until ((Weekday(Range("A" & ActiveCell.Row - 1)) = 6) And _
(DateAdd("w", 3, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date))) Or _
((Weekday(Range("A" & ActiveCell.Row - 1)) <> 6) And _
(DateAdd("d", 1, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date)))
If Weekday(Range("A" & ActiveCell.Row - 1)) = 6 Then
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 3, Range("A" & (ActiveCell.Row - 1))))
Selection.NumberFormat = "m/d/yyyy"
ElseIf Weekday(Range("A" & ActiveCell.Row - 1)) = 7 Then
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 2, Range("A" & (ActiveCell.Row - 1))))
ActiveCell.Select
Selection.NumberFormat = "m/d/yyyy"
Else: ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 1, Range("A" & (ActiveCell.Row - 1))))
ActiveCell.Select
Selection.NumberFormat = "m/d/yyyy"
End If
Selection.Offset(1, 0).Activate
Loop
'Add in the "Beyond" date, to column(A:A)
ActiveCell.Value = "Beyond " & Format((DateAdd("d", 90, Date)), "mm/dd/yy")
Range("A1").Select
'*****************************************************************************************
'****************************************************************
'Copies down formulas to the last date or "Beyond MM/DD/YYYY" row
'****************************************************************
'Set LastRow Value for end of desired formula range
LTCashSheet_LastRow = Range("A" & Rows.count).End(xlUp).Row
'Set LastRow Value for beginning formulas to copy down
LTCashSheet_BegCopyRange = Range("B" & Rows.count).End(xlUp).Row
Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_BegCopyRange).Select
Selection.AutoFill Destination:=Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow), Type:=xlFillDefault
Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow).Select
Columns("A:A").AutoFit
'****************************************************************
'****************************************************************
'Hide Rows 11 through rows prior to today's date row*************
'****************************************************************
Set TheRng = Range("A1", Range("A" & Rows.count).End(xlUp))
CurrDtRow = TheRng.Find(What:=Date, LookAt:=xlWhole).Row
Rows("11:" & (CurrDtRow - 2)).Select
Selection.EntireRow.Hidden = True
Range("A1").Select
'****************************************************************
'Go to next sheet and repeat, through 'count'********************
ActiveSheet.Next.Select
Next count
I found helpful information from Excel VBA date formats. I did not integrate the solution to prevent the above from happening, within my IF THEN ELSE; however, I was able to add some clean up using the function and applying the code to the cells immediately above the "Beyond" value, which were the cells that were a strange hybrid of a String and a Date. I am good to go, but, feel free to comment if you think I should have gone a different route.
Thank you!
Function CellContentCanBeInterpretedAsADate(cell As Range) As Boolean
Dim d As Date
On Error Resume Next
d = CDate(cell.Value)
If Err.Number <> 0 Then
CellContentCanBeInterpretedAsADate = False
Else
CellContentCanBeInterpretedAsADate = True
End If
On Error GoTo 0
End Function
Sub FixDtFrmtWithFnctn()
Dim cell As Range
Dim cvalue As Double
Sheets("NCE1").Select
Set TheRng4 = Range("A1", Range("A" & Rows.count).End(xlUp))
DtFrmtFixRow = TheRng4.Find(What:=("Beyond"), LookAt:=xlPart).Row
Set cell = Range("A" & (DtFrmtFixRow - 1))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
Set cell = Range("A" & (DtFrmtFixRow - 2))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
Set cell = Range("A" & (DtFrmtFixRow - 3))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
End Sub
I have the following code, which is a work in progress, but VBA keeps saying the If Range("G"&CRow).text = "True" then is true in the highlighted row, when it obviously isn't. Can anyone help me figure this out?
Range("G1").FormulaR1C1 = _
"=IF(OR(ISNUMBER(SEARCH(""GS "",RC[-6])),ISNUMBER(SEARCH(""#"",RC[-6]))),""TRUE"",""FALSE"")"
Range("G1").AutoFill Destination:=Range("G1:G" & lastrow)
With Range("G1:G" & lastrow)
.Value = .Value
End With
Dim T As Integer
Dim CRow As Integer
CRow = 1
For Each cell In Range("G1:G" & lastrow)
If Range("G" & CRow).Text = "TRUE" Then
cell.Select
ActiveCell.Offset(0, -5).Select
If Selection.Value = "" Then
Selection.Resize(, 4).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
CRow = CRow - 1
End If
Else
CRow = CRow + 1
End If
Next
BECAUSE of this
CRow = 1
For Each cell In Range("G1:G" & lastrow)
If Range("G" & CRow).Text = "TRUE" Then
You are assiging 1 to CRow and using that in each iteration. So actually you are always testing Just Row 1.
Change Range("G" & CRow).Text to cell.Text
See below example to delete the same group of cells using a reverse loop and not selecting. I believe I interpreted, and thus changed, this line properly ActiveCell.Offset(2, 0).Select, but let me know if I'm mistaken and it doesn't function as expected.
Range("G1").FormulaR1C1 = _
"=IF(OR(ISNUMBER(SEARCH(""GS "",RC[-6])),ISNUMBER(SEARCH(""#"",RC[-6]))),""TRUE"",""FALSE"")"
Range("G1").AutoFill Destination:=Range("G1:G" & lastrow)
With Range("G1:G" & lastrow)
.Value = .Value
End With
Dim T As Integer
For T = 1 to lastrow Step -1
Set cell = Range("G" & T)
If cell.Text = "TRUE" Then
If cell.offset(0,-5) = "" Then
cell.Offset(0,-5).Resize(,4).Delete Shift=xlUp
Range("G" & T + 2).Insert Shift:=xlDown CopyOrigin:=xlFormatFromLeftOrAbove
End If
End If
Next
Sub CHECKas()
Dim lastrow As Long
Dim lastcol As Long
Dim l As Integer
Dim i As Integer
Dim rname As Constants
Set rngTarg = Selection
lastrow = Sheets("report").Range("B" & Rows.Count).End(xlUp).row
lastcol = Sheets("report").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("FEBBRAIO").Select
ActiveCell.Offset(0, -3).Copy
Sheets("REPORT").Select
Cells(1, lastcol + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
rname = Application.ActiveCell.Value
ActiveCell.Offset(1, 0).Select
For i = 2 To lastrow
ThisWorkbook.Sheets("report").Select
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
Next i
End Sub
I'm new in VBA and I can't understand how to compare a constant value with each cell in a range("g2:g" & lastrow) and ("f2:f" & lastrow). The constant value is an active cell in my case. For example considering this formula: IF(AND($R$1<G2;$R$1>=f2);1;0 where R$1$ is the active cell of the last not empty column in ROW 1. I need to fill the entire column (that is activecell.column) with the output coming out form this formula.
But the I Got mismatch error in:
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
I know from the previous question that this error occurs because I'm trying to comparing a single value against an array of values. How can fix this problem?
You have to use
Range("F" & i)
in your code. Same thing applies to other instances of such code.