I need to create output like the following:
Column A | Column B
1. 1 1
2. 1
3. 2 2
4. 2
5. 2
So far, I have written the following code:
Sub ItemNum()
Dim rng As Range
Dim i As Long
Dim cell
Set rng = Range("A1:A99")
i = 1
For Each cell In rng
If (...) Then
cell.Offset(0, 1).Value = i
End If
Next
End Sub
I have already obtained the number sequence in column A. I need to add the same value in column B down to the column.
I would like to know how to add to increment statement.
Thanks
If what you are wanting to do is place a value from column A into every cell in column B until you come to another value in Column A, then the following should work:
Sub ItemNum()
Dim rng As Range
Dim i As Variant
Dim cell
Set rng = Range("A1:A99")
i = "Unknown"
For Each cell In rng
If Not IsEmpty(cell) Then
i = cell.value
End If
cell.Offset(0, 1).Value = i
Next
End Sub
You can do this without loops (quicker code):
Sub FastUpdate()
Dim rng1 As Range
Set rng1 = Range([a2], Cells(Rows.Count, "a").End(xlUp))
'add two rows
Set rng1 = rng1.Resize(rng1.Rows.Count + 2, 1)
'add first row
[b1].Value = [a1].Value
With rng1
.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1],R[-1]C)"
.Offset(0, 1).Value = .Offset(0, 1).Value
End With
End Sub
If you use a For...Next loop instead of For...Each loop then you can use the counter variable to address the cells in column B:
Option Explicit
Sub ItemNum()
Dim rng As Range
Dim lngCounter As Long
Dim strCellValue As String
Set rng = Range("A1:A99")
strCellValue = 0
For lngCounter = 1 To rng.Cells.Count
If rng(lngCounter, 1).Value <> "" Then
strCellValue = rng(lngCounter, 1).Value
End If
rng(lngCounter, 2).Value = strCellValue
Next
End Sub
E.g.
If i understand correctly, below is the answer for you.
Assuming your data starts with A2 then Apply the below formula in B2 and drag down up to the last
=IF(A2<>"",A2,B1)
Note: A column data may be Number or anything.
Proof
Related
I have 2 sheets. Sheet1 has 2 rows: column names and values.
Sheet 2 is a master sheet with all the possible column names in. I need to copy the values from sheet 1 into their appropriate column.
I think i can do this via a match function, and so far i have this:
Sub dynamic_paste()
Dim Columnname As String
Dim inputvalue As String
Dim starter As Integer
Dim i As Integer
starter = 0
For i = 1 To 4
'replace 4 with rangeused.rows.count?
Sheets("sheet1").Select
Range("a1").Select
ActiveCell.Offset(0, starter).Select
Columnname = ActiveCell
'sets columnname variable
ActiveCell.Offset(1, 0).Select
inputvalue = ActiveCell
'sets inputname variable
Sheets("sheet2").Select
'**Cells(0, WorksheetFunction.Match(Columnname, Rows(1), 0)).Select**
Range("a1").Offset(1, starter).Value = inputvalue
'inputs variable in the next cell along
starter = starter + 1
Next
End Sub
I need to find out how to use my columnname variable as the matching value, and then offset down to the first row that is empty - then change the value of that cell to the variable called inputvalue.
For extra points: I need to make sure the code doesnt break if they dont find a matching value, and if possible put any values that dont match into the end of the row?
What about this:
Dim LR As Long, X As Long, LC As Long, COL As Long
Dim RNG As Range, CL As Range
Option Explicit
Sub Test()
LR = Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Row 'Get last used row in your sheet
LC = Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column 'Get last used column in your sheet
Set RNG = Sheets(2).Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, LC))
'Loop through all the columns on your sheet with values
For X = 1 To Sheets(1).Cells(1, Sheets(1).Columns.Count).End(xlToLeft).Column
Set CL = RNG.Find(Sheets(1).Cells(1, X).Value, lookat:=xlWhole)
If Not CL Is Nothing Then
COL = CL.Column
Sheets(2).Cells(LR + 1, COL).Value = Sheets(1).Cells(2, X).Value 'Get the value on LR offset by 1
Else
Sheets(2).Cells(1, Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column).Value = Sheets(1).Cells(1, X).Value
Sheets(2).Cells(LR + 1, Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column).Value = Sheets(1).Cells(2, X).Value
End If
Next X
End Sub
This way you will avoid using select. Which is very recommandable!
This is Sheet1:
This is Sheet2:
This is the code:
Option Explicit
Sub DynamicPaste()
Dim col As Long
Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
For col = 1 To 3
Dim currentRow As Long
currentRow = WorksheetFunction.Match(wks2.Cells(1, col), wks1.Columns(1))
wks2.Cells(2, col) = wks1.Cells(currentRow, 2)
Next col
End Sub
This is Sheet2 after the code:
This is a must-read - How to avoid using Select in Excel VBA
I've written code to loop through a range for a specific value. If the value equals "123" then highlight the entire row green. However, I only want it to highlight the very first two matches it finds and stop there. Many thanks.
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
Sheets("XYZ").Select
Set rng = Range("L2:L10000")
For Each cell In rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
End If
Next
End Sub
It's better if you avoid using Select and other relatives, instead use referenced Objects, Sheets and Ranges.
Also, you can search for the last row with data in Column L instead of just looping through row 10000.
Option Explicit
Sub Macro3()
Dim Rng As Range, cell As Range
Dim counter As Integer, LastRow As Long
With Sheets("XYZ")
' find last row at Column "L"
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
Set Rng = .Range("L2:L" & LastRow)
For Each cell In Rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
counter = counter + 1
End If
If counter >= 2 Then Exit For
Next
End With
End Sub
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
dim count as integer
'Set the range in column D to loop through
Sheets("XYZ").Select
Set rng = Range("L2:L10000")
For Each cell In rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
count = count + 1
End If
if count >= 2 Then exit For
Next
End Sub
Filtering lets you avoid looping through cells
Assuming row 1 has header, you can try:
Dim cell As Range
Dim counter As Integer
With Sheets("XYZ")
With .Range("L1", .Cells(.Rows.Count, "L").End(xlUp)) '<--| reference its column "L" cells from row 1 (header) down to last not empty row
.AutoFilter field:=1, Criteria1:="123" '<--| filter referenced range on its first (and only) column with "123"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell gets filtered
For Each cell In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--| loop through filtered cells, skipping header
cell.EntireRow.Interior.ColorIndex = 4
counter = counter + 1 '<--| update counter
If counter = 2 Then Exit For '<--| exit at 2nd iteration
Next cell
End If
End With
.AutoFilterMode = False
End With
Here's your code with some addition:
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
greenrows = 0
Sheets("XYZ").Select
Set rng = Range("b2:b10000")
For Each cell In rng
If cell.Value = "123" Then
If greenrows = 2 Then Exit Sub
cell.EntireRow.Interior.ColorIndex = 4
greenrows = greenrows + 1
End If
Next
End Sub
I want to look in a range and find flag certain values, then populate the same row in another column based on those values.
Column 1 Column 2
Code1
Code10
If I specify Code1 in the macro, I want to populate column 2.
I have the following code. I get a runtime error. How can I avoid a runtime error.
Sub Test()
With Sheets("Sheet1")
Set r = .Range("A:A").Find(what:="Old", LookIn:=xlValues)
Dim rownum As Long
rownum = r.Row
Dim rownum2 As Long
rownum2 = rownum - 1
With Sheets("Sheet1")
Set r2 = .Range("C6:C" & rownum2)
Dim cell As Variant
For Each cell In r2
If Cells.Value = ("Code1" Or "Code2" Or "Code3" Or "Code4") Then
.Select
.Offset(0, 7).Value = "Special"
End If
Next cell
End With
End With
End Sub
I cleaned it up a little:
Sub Test()
Dim r2 As Range
Dim rownum2 As Long
Dim cell As Range
With Sheets("Sheet1")
rownum2 = .Range("A:A").Find(what:="Old", LookIn:=xlValues).Row - 1
Set r2 = .Range("C6:C" & rownum2)
End With
For Each cell In r2
If cell.Value = "Code1" Or cell.Value = "Code2" Or cell.Value = "Code3" Or cell.Value = "Code4" Then
cell.Offset(0, 7).Value = "Special"
End If
Next cell
End Sub
The main issue was the If statement. See above for the proper method of using the Or statement.
I'm looking for some code that will look at Column A and as long as the cell in Column A is not blank, then the corresponding cell in Column B will equal a specific value.
So if Cell A1 <> "" then Cell B1.Value = "MyText"
And repeat until a cell in Column A is blank or empty.
To add a little more clarification, I have looked through the various loop questions asked and answered here. They were somewhat helpful. However, I'm unclear on how to get the loop to go through Column A to verify that each cell in Column A isn't blank AND in the corresponding cell in Column B, add some text that I specify.
Also, this will need to be part of a VBA macro and not part of a cell formula such as =IF
If you really want a vba solution you can loop through a range like this:
Sub Check()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A100")
dat = rng
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
rng(i, 2).Value = "My Text"
End If
Next
End Sub
*EDIT*
Instead of using varients you can just loop through the range like this:
Sub Check()
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("A1:A100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "My Text"
End If
Next
End Sub
Another way (Using Formulas in VBA). I guess this is the shortest VBA code as well?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B1:B" & lRow).Formula = "=If(A1<>"""",""My Text"","""")"
.Range("B1:B" & lRow).Value = .Range("B1:B" & lRow).Value
End With
End Sub
A simpler way to do this would be:
Sub populateB()
For Each Cel in Range("A1:A100")
If Cel.value <> "" Then Cel.Offset(0, 1).value = "Your Text"
Next
End Sub
Use the function IF :
=IF ( logical_test, value_if_true, value_if_false )
I have one file with two worksheets, both are full of names and addresses. I need a macro that will highlight rows in the first sheet if the cell A of that row does not match any rows from column A of the second sheet.
So if the first cell in a row has no matching data in any of the data in column A of sheet2 then that row is highlighted red.
Also I might want to expand this in the future so could I also specify that Sheet1 can be the active sheet, but sheet2 is called by the sheet name?
Try below code :
Sub Sample()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
End If
Next
End Sub
Here's an ugly brute-force approach:
Dim r As Range
Dim s As Range
For Each r In ActiveSheet.UsedRange.Rows
For Each s In Sheets("Sheet2").UsedRange.Rows
If r.Cells(1, 1).Value = s.Cells(1, 1).Value Then
r.Interior.ColorIndex = 3
End If
Next s
Next r
Here's a slicker way:
Dim r As Range
Dim s As Range
Set s = Sheets("Sheet2").Columns(1)
For Each r In ActiveSheet.UsedRange.Rows
If Not (s.Find(r.Cells(1, 1).Value) Is Nothing) Then
r.Interior.ColorIndex = 3
End If
Next r
how about this:
Sub CondFormatting()
Range("D1:D" & Range("A1").End(xlDown).Row).Formula = "=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),""NOT FOUND"",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))"
With Columns("D:D")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NOT FOUND"""
.FormatConditions(1).Interior.ColorIndex = 3
End With
Range("I16").Select
End Sub
here is an approach using a Worksheet formula:
=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),"NOT FOUND",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))
then you would use Conditional formatting to turn the cells red if column A doesn't find a match!
HTH
Philip