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.
Related
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]};
""
)
I have a sheet with two columns. Column (E) contains ID and names from the data source and column (K) contains ID,which are extracted from comment section.
Column E contains sometime ID, starting with B2C, and sometime names and Id starting with 5. column K contains always ID starting with B2C. the length of the ID B2C is usually 11 to 13 Digit Long. the length of ID starting with 5 is 8 Digit Long.
I would like to have a VBA that checks both the columns, if there is an id starting with 5 or some Name in column E, then it should look into column K, if an ID starting with B2C is present, then it should copy to Column L, else copy the same value(from column E) to column L.
I researched through find and replace. I saw examples where exact Name of find was given and replaced with given Name. I am able to form an algorithm, but struck how to start with code in my case. the code below, has an runn time error
object varaible or with block variable not set .
Sub compare()
Dim i As Long
Dim ws As Worksheet
ws = Sheets("Sheet1")
For i = 1 To Rows.Count
If ws.Cells(i, 11).Value = "" Then
ws.Cells(i, 12).Value = ws.Cells(i, 5).Value
Else
ws.Cells(i, 12).Value = ws.Cells(i, 11).Value
End If
Next i
End Sub
I have an Image below, which Shows the end result.
Any lead would be appreciated.
The issue causing the error message is that you are missing a Set statement for your worksheet object. You must use Set when assigning an object to a variable, that is anything with its own methods. A simple data type without methods (String, Integer, Long, Boolean, ...) doesn't need the Set statement, and can just be directly assigned like i = 0.
Your code should be updated to:
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
' RED FLAG! Rows.Count is going to cause you to loop through the entire column,
' see the below example for how to use the UsedRange property.
For i = 1 To Rows.Count
If ws.Cells(i, 11).Value = "" Then
ws.Cells(i, 12).Value = ws.Cells(i, 5).Value
Else
ws.Cells(i, 12).Value = ws.Cells(i, 11).Value
End If
Next I
An alternative which avoids even using a worksheet variable would be to use a With block:
Dim r As Long
With ThisWorkbook.Sheets("Sheet1")
For r = 2 To .UsedRange.Rows.Count
.Range("L" & r).Value = .Range("E" & r).Value
If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value
Next r
End With
Edit:
There are various ways to find the last used row, each with their drawbacks. A drawback of both UsedRange and xlCellTypeLastCell is they are only reset when you save/close/re-open the workbook. A better solution can be found in this answer.
Sub compare()
Dim r As Long, lastrow As Long, ws As WorkSheet
Set ws = ThisWorkbook.Sheets("Sheet1")
lastrow = LastRowNum(ws)
With ws
For r = 2 To lastrow
.Range("L" & r).Value = .Range("E" & r).Value
If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value
Next r
End With
End Sub
' Function from linked question
Public Function LastRowNum(Sheet As Worksheet) As Long
LastRowNum = 1
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
LastRowNum = Sheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End Function
This is my solution:
Option Explicit
Sub Compare()
Dim i As Long
Dim lngLastRow As Long
Dim ws As Worksheet
lngLastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set ws = Worksheets(1)
With ws
.Columns(12).Clear
.Cells(1, 12) = "Extract from Comment"
For i = 1 To lngLastRow
If .Cells(i, 11).Value = "" Then
.Cells(i, 12).Value = ws.Cells(i, 5).Value
Else
.Cells(i, 12).Value = ws.Cells(i, 11).Value
End If
Next i
End With
End Sub
It clears column(12) and writes Extract from comment in the first cell of the row, to make sure that everything is clean.
lngLastRow is the last row of the sheet.
I'm using a vlookup to pull a date from another sheet and I'm referencing a cell in the sheet that I want it to pull to. I want to drag the vlookup down but I can't figure out how to anchor the formula so it remains the same when I drag it down. Also I'm referencing cell "I2" and then I want the Vlookup then to reference "I3" and so on, but I'm not exactly sure how to code it. Any help would be appreciated! Here's my code:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
Sheets("SJ360 for Source 140").Select
Range("H1").Select
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
On Error GoTo myerrorhandler:
Dim x
With ThisWorkbook.Worksheets("SJ360 for Source 140")
x = Application.WorksheetFunction.VLookup(Range("I2"), StoreData, 3, False)
Range("H2").Value = x
End With
Dim FillFormula As Variant
x = x + 1
With ThisWorkbook.Sheets("SJ360 for Source 140")
Range("H2").Select
ActiveCell.Offset(x, 0).Select
FillFormula = "VLookup(x), StoreData, 3, False)"
.Range("H2:H&lastrow").Formula = FillFormula
.Range("H&lastrow").FillDown
End With
myerrorhandler:
If Err.Number = 1004 Then
MsgBox "Value not found"
End If
I tried to make it so x would be "I2" then "I3" etc but I didn't do it right.
Try this. When trying to fill the same formula down a range use R1C1:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
With Sheets("SJ360 for Source 140")
.Range("H1").EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("H2:H" & lastrow).FormulaR1C1 = "Vlookup(RC1," & StoreData.Address(1, 1, xlR1C1, True) & ",2,False)"
End With
If all you want is the value in the cells then use this:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
With Sheets("SJ360 for Source 140")
.Range("H1").EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("H2:H" & lastrow).Value = .Evaluate("INDEX(Vlookup(I2:I" & lastrow & "," & StoreData.Address(1, 1,,True) & ",2,False),)")
End With
My cell values are strings of numbers (always greater than 5 numbers in a cell, ie 67391853214, etc.)
If a cell starts with three specific numbers (ie 673 in a cell value 67391853214) I want the data in the cell to be replaced with a different value (if 673 are the first numbers, replace entire cell value with "790")
I know there's a way to use an asterick to use only part of the cell value but I'm not 100% on the syntax. This is the current code I have, but it's searching for specifically "###*", not values that start with "###". Any and all help is greatly appreciated!
lastRow = Range("A" & Rows.Count).End(xlUp).Row
colNum = WorksheetFunction.Match("Number", Range("A1:CC1"), 0)
For Each c In Range(Cells(2, colNum), Cells(lastRow, colNum))
If c.Value = "614*" _
Or c.Value = "626*" _
Or c.Value = "618*" _
Or c.Value = "609*" _
Or c.Value = "605*" Then
c.Value = "737"
`
Use the LEFT() function, as shown below:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
colNum = WorksheetFunction.Match("Number", Range("A1:CC1"), 0)
For Each c In Range(Cells(2, colNum), Cells(lastRow, colNum))
If LEFT(c.Value,3) = "614" _
Or LEFT(c.Value,3) = "626" _
Or LEFT(c.Value,3) = "618" _
Or LEFT(c.Value,3) = "609" _
Or LEFT(c.Value,3) = "605" Then
c.Value = "737"
Better to do a range replace rather than loop through each cell for speed:
Dim rng1 As Range
Dim LastRow As Long
Dim ColNum As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
ColNum = Application.Match("Number", Range("A1:CC1"), 0)
On Error GoTo 0
If Column Is Nothing Then Exit Sub
Set rng1 = Range(Cells(2, ColNum), Cells(LastRow, ColNum))
With rng1
.Replace "626*", "727", xlWhole
.Replace "618*", "727", xlWhole
.Replace "609*", "727", xlWhole
.Replace "737*", "727", xlWhole
End With
Here is my take on the problem:
Sub SO()
Dim MyString As String
MyString = "614,626,618,609,605"
For X = 1 To Range("C" & Rows.Count).End(xlUp).Row
If Replace(MyString, Left(Range("C" & X).Value, 3), "") <> MyString Then Range("C" & X).Value = "737"
Next
End Sub
I'm using this script to insert fill with rows where non-sequential is produced in a column of an excel file.
Sub InsertValueBetween()
Dim lastrow As Long
Dim gap As Long
Dim i As Long, ii As Long
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 3 Step -1
gap = .Cells(i, "A").Value - .Cells(i - 1, "A").Value
If gap > 1 Then
.Rows(i).Resize(gap - 1).Insert
End If
Next i
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(3, "A").Value = .Cells(2, "A").Value + 1
.Cells(2, "A").Resize(2).AutoFill .Cells(2, "A").Resize(lastrow - 1)
End With
End Sub
In addition to adding these new rows I want them to also have a specific value in column B. I'm trying to implement this but with no result.
Anybody could help me?
One way you could tackle this challenge is with a Range variable. Here is some heavily-commented code that walks through the process:
Sub InsertValueBetweenRev2()
Dim Target As Range '<~ declare the range variable
'... declare your other variables
'... do other stuff
For i = lastrow To 3 Step -1
gap = .Cells(i, "A").Value - .Cells(i - 1, "A").Value
If gap > 1 Then
.Rows(i).Resize(gap - 1).Insert
'the next line sets the range variable to the recently
'added cells in column B
Set Target = .Range(.Cells(i, 2), .Cells(i + gap - 2, 2))
Target.Value = "Cool" '<~ this line writes text "Cool" into those cells
End If
Next i
'... the rest of your code
End Sub
So, to sum it up, we know that gap - 1 rows are going to be added, and we know that the new rows are added starting at row i. Using that knowledge, we assign the just-added cells in column B to a Range then set the .value of that Range to whatever is needed.
a Better way of doing it with less variables and faster:
Sub InsRowWithText()
Dim LR As Long, i As Long
LR = Range("D" & Rows.Count).End(xlUp).row
For i = LR To 3 Step -1
If Range("D" & i).Value <> Range("D" & i - 1).Value Then
Rows(i).Resize(1).Insert
Range("D" & i).Value = "Test"
End If
Next i
End Sub
This is how i utilized it:
Sub InsRowWithText()
Dim strMsg As String, strTitle As String
Dim LR As Long, i As Long
Text = "ADD"
strMsg = "Warning: This is a Advanced Function, Continue? "
strTitle = "Warning: Activated Advanced Function "
If MsgBox(strMsg, vbQuestion + vbYesNo, strTitle) = vbNo Then
Exit Sub
Else
Sheets("SAP Output DATA").Select
If Range("D3").Value = Text Then
MsgBox "Detected That This Step Was Already Completed, Exiting."
Exit Sub
End If
application.ScreenUpdating = False
LR = Range("D" & Rows.Count).End(xlUp).row
For i = LR To 3 Step -1
If Range("D" & i).Value <> Range("D" & i - 1).Value Then
Rows(i).Resize(1).Insert
Range("D" & i).EntireRow.Interior.ColorIndex = xlColorIndexNone
Range(("A" & i), ("D" & i)).Value = Text
End If
Next i
End If
Range("D2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Range(("A" & ActiveCell.row), ("D" & ActiveCell.row)).Value = Text 'last row doesnt get text for some reason.
ActiveCell.EntireRow.Interior.ColorIndex = xlColorIndexNone
ActiveCell.Offset(1).Select
Range(("D" & ActiveCell.row), ("E" & ActiveCell.row)).Interior.ColorIndex = 17 'purple
application.ScreenUpdating = True
Range("D3").Select
End Sub