I have a two column look up table. Column 1 is a fixed list of items and column 2 has a formula in it.
In another table when someone enters data in say cell a1 and it matches an item in column 1 of my look up table I need the corresponding formula from column 2 copied and pasted into cell b2.
Lots of google searching trying to find a way for VLOOKUP to copy formula in lieu of cell value has returned nothing so I assume the only way to do it is via VBA?
This small sample assumes the data is in columns C and D:
Sub Matt()
Dim r As Range, Tabl As Range
Set Tabl = Range("C1:C1000")
Set r = Tabl.Find(What:=Range("A1").Value, After:=Tabl(1))
Range("B1").Formula = r.Offset(0, 1).Formula
End Sub
place a value in A1 and run the macro
EDIT#1:
This version will loop down column A
Sub Matt_The_Sequel()
Dim r As Range, Tabl As Range, N As Long
Set Tabl = Range("C1:C1000")
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
Set r = Tabl.Find(What:=Range("A" & i).Value, After:=Tabl(1))
Range("B" & i).Formula = r.Offset(0, 1).Formula
Next i
End Sub
EDIT#2:
Sub Matt_The_Sequel2()
Dim r As Range, Tabl As Range, N As Long
Dim First_Row As Long
Set Tabl = Range("C1:C1000")
N = Cells(Rows.Count, "A").End(xlUp).Row
First_Row = 4
For i = First_Row To N
Set r = Tabl.Find(What:=Range("A" & i).Value, After:=Tabl(1))
Range("B" & i).Formula = r.Offset(0, 1).Formula
Next i
End Sub
Related
I have 2 columns A and B
I want to copy the Column A data into Column B. There are few blank cells in A, but those blanks should not overwrite any data in column B. Only the cells which have data should be copied into B.
How can this be achieved in VBA?
This is probably not a complete solution, but might give you some ideas:
Sub test()
Dim R As Range
Set R = Range("A:A").SpecialCells(xlCellTypeConstants, 23)
R.Offset(0, 1).Value = R.Value
End Sub
If the data in column A include computed values, this might not work as intended.
Since you have a conditional paste, you will need to loop here. Check each value in Column A and move the VALUE to Column B (if-and-only-if Column A is not blank)
Sub Jeeped()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("A" & i) <> "" Then
ws.Range("B" & i).Value = ws.Range("A" & i).Value
End If
Next i
End Sub
I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub
I need to use VBA code to populate a list of filtered blank cells. I decided to make a picture with small example to explain it easier. Column D should be populated with names from col A repeating until each ID has a name.
I have absolutely no idea how to loop it to make it work - it's mind boggling! I have been searching the web for hours so I am now asking for help. Please note that column C and D are filtered with criteria blanks for column D.
Here is working code to populate blank cells of a filtered list with the same 3 names alternating.
Sub Macro1()
Dim last As Long
Dim counter As Integer
Dim nameRange As Range
Dim cell As Range
last = Range("A2").End(xlDown).Row
Set nameRange = Range("D2:D" & last).SpecialCells(xlCellTypeVisible)
counter = 1
For Each cell In nameRange
If counter = 1 Then
cell.Value = "Carrie"
counter = counter + 1
ElseIf counter = 2 Then
cell.Value = "Lisa"
counter = counter + 1
Else
cell.Value = "Bob"
counter = 1
End If
Next
End Sub
thanks for everyone's input - Hopefully, this will help someone else in the future.
This will do it without the need of filtering the data.
Sub foo()
Dim ws As Worksheet
Dim lastrowa As Long
Dim lastrowd As Long
Dim counta As Long
Dim rng As Range
counta = 2 'First row of name list in column A
Set ws = Sheets("Sheet1")
With ws
lastrowa = .Range("A" & .Rows.Count).End(xlUp).Row
lastrowd = .Range("D" & .Rows.Count).End(xlUp).Row
For Each rng In .Range(.Cells(2, 5), .Cells(lastrowd, 5))
If rng.Value = "" Then
rng.Value = .Cells(counta, 1).Value
If counta = lastrowa Then
counta = 2
Else
counta = counta + 1
End If
End If
Next rng
End With
End Sub
Range("D2:D4").Value = Range("A2:A4").Value
Range("D2:D4").AutoFill Destination:=Range("D2:D11")
If you don't know where column C ends that is easy enough to work out. Something like
Range("D2:D4").Value = Range("A2:A4").Value
Range("D2:D4").AutoFill Destination:=Range(Range("D2"), _
Range("C2").End(xlDown).Cells(1, 2))
If you don't know how far the data extends in column A:
Dim last As Integer
last = Range("A2").End(xlDown).Row
Range("D2:D" & last).Value = Range("A2:A" & last).Value
Range("D2:D" & last).AutoFill Destination:=Range(Range("D2"), _
Range("C2").End(xlDown).Cells(1, 2))
My example doesn't work perfectly, or even well... Its late :)
Create a named range that encapsulates all your "names" (called namesRange in my example).
In your "assigned" column put the following formula:
=INDEX(namesList,ROW()-((INT(ROW()/ROWS(namesList))*ROWS(namesList))),1)
Update...
Thought about it, and remembered how to excel a little more.. The following is what I was trying to do in my first example.
=INDEX(namesList,MOD(ROW()-1,ROWS(namesList)-1)+1,1)
I have a value in Column A which I want to write to a separate sheet, there are column and row numbers which specify the location I want to write that value in the same row as the value in column A.
For instance the value in A8 has column number "2" in Q8 and row number "118" in S8. So I want to write a formula in the new sheet which puts the value of A8 into cell B118 in the new sheet. And for this to go down with all the values in A:A as the first sheet continues to be filled in.
I've tried doing this with sumifs formula here but its not quite working out;
=IF(SUMIFS(sheet1!$A:$A,sheet1!$Q:$Q,COLUMN(B8),sheet1!$S:$S,ROW(B8))," ",sheet1!$A:$A)
If you want the formula in the new sheet to reference the cell in Sheet1 then:
Sub marine()
Dim cl As Long, rw As Long, source As String
cl = Range("Q8").Value
rw = Range("S8").Value
Sheets("new").Cells(rw, cl).Formula = "=Sheet1!A8"
End Sub
and if you simply want A8's value transferred to the new sheet, then:
Sub marine2()
Dim cl As Long, rw As Long, source As String
cl = Range("Q8").Value
rw = Range("S8").Value
Sheets("new").Cells(rw, cl).Value = Range("A8").Value
End Sub
EDIT#1:
Here is a version that will handle the entire column:
Sub marine3()
Dim cl As Long, rw As Long, source As String
Dim i As Long, N As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To N
cl = Range("Q" & i).Value
rw = Range("S" & i).Value
If cl <> 0 And rw <> 0 Then
Sheets("new").Cells(rw, cl).Value = Range("A" & i).Value
End If
Next i
End Sub
Here is my answer.
Sub movindData()
'take all the data from sheet1 and move it to sheet2
Dim sht2 As Worksheet
Dim r
Dim c
Dim i
Dim rng As Range
Dim A 'for each value in column A
Dim Q 'for each value in column Q (the column)
Dim S 'for each value in column S (the row)
r = Range("A1").End(xlDown).Row 'the botton of columns A, the last row
'I take the inicial cells as a A1, but you
'can change it as you need.
c = 1 'the column A
Set rng = Range(Cells(1, 1), Cells(r, c)) 'this takes just the range with the data in columns A
Set sht2 = Sheets("Sheet2")
For Each i In rng
A = i.Value 'Store the value of every cell in column A
Q = i.Offset(0, 16).Value 'Store the value of every cell in column Q (the destination column in sheet2)
S = i.Offset(0, 18).Value 'Store the value of every cell in column s (the destination row in sheet2)
sht2.Cells(Q, S).Value = A
Next i
End Sub
I have fours lists in Excel of arbitraty lenght.
A B C D
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 D3
A4 D4
D5
I want to create one table that has every combination from the lists as rows.
A B C D
A1 B1 C1 D1
A1 B1 C1 D2
...
A4 B3 C2 D5
Is there any simple way to do this in Excel - using Excel functionality, formulas or VBA?
If you have your four lists next to each other, highlight the data and insert a pivot table.
Add each of the columns to the "rows" section of the pivot table.
Right-click on each field in turn and click on "Field Settings".
Set the Layout and print to show tabular form, repeated item labels and items with no data as follows.
And this is the resulting table.
I suspect you'll want to delete the rows which contain 1 or more (blank) rows.
This is probably easiest by adding a formula to column E along the lines of
=IF(A2="(blank)",1,0)
Repeat this for the other columns, Add them up and sort by the total.
Delete all rows that have a non-zero entry.
Some nested for statements should handle this problem. Just put this in the VBA for your project and it will create a macro called CreateTable() which should put the table in a new worksheet for you.
Sub CreateTable()
'Creates a table will all combinations of values from four columns
Dim a, b, c, d As Range
'Activates sheet that has data on it to be copied to table
Worksheets("Sheet1").Activate 'Change Sheet1 to the name of your sheet
'Change A2 to first cell of data you want to be copied over
Set a = Range("A2", Range("A2").End(xlDown))
Set b = Range("B2", Range("B2").End(xlDown))
Set c = Range("C2", Range("C2").End(xlDown))
Set d = Range("D2", Range("D2").End(xlDown))
Dim i As Integer
i = 1 'Row number of the first row of data for the table of combinations
Worksheets("Sheet2").Activate 'Change Sheet2 to name of sheet you want the table to be put on
For Each cellA In a.Cells
For Each cellB In b.Cells
For Each cellC In c.Cells
For Each cellD In d.Cells
Worksheets("Sheet2").Cells(i, 1) = cellA.Value
Worksheets("Sheet2").Cells(i, 2) = cellB.Value
Worksheets("Sheet2").Cells(i, 3) = cellC.Value
Worksheets("Sheet2").Cells(i, 4) = cellD.Value
i = i + 1
Next cellD
Next cellC
Next cellB
Next cellA
End Sub
You should show what you've tried already and give specifics of where your data is coming from, but here's a VBA solution. Loops through each item in a given column, for as many rows as there are total combinations of items.
Sub Combination_Table()
Dim rList1 As Range
Dim rList2 As Range
Dim rList3 As Range
Dim rList4 As Range
Dim lLength1 As Long
Dim lLength2 As Long
Dim lLength3 As Long
Dim lLength4 As Long
Dim lRowcounter As Long
Sheets(1).Activate
With Sheets(1)
lLength1 = .Range("A" & .Rows.Count).End(xlUp).Row - 1
lLength2 = .Range("B" & .Rows.Count).End(xlUp).Row - 1
lLength3 = .Range("C" & .Rows.Count).End(xlUp).Row - 1
lLength4 = .Range("D" & .Rows.Count).End(xlUp).Row - 1
Set rList1 = .Range("A2:A" & lLength1)
Set rList2 = .Range("B2:B" & lLength2)
Set rList3 = .Range("C2:C" & lLength3)
Set rList4 = .Range("D2:D" & lLength4)
End With
'The above marks the ranges containing the original un-combined lists,
'with no duplicates and assuming row 1 is the header and all data is on
'columns A-D, without blanks.
rowcounter = 0
Sheets(2).Activate
For i = 1 To lLength1
For j = 1 To lLength2
For k = 1 To lLength3
For l = 1 To lLength4
rowcounter = rowcounter + 1
Sheets(2).Range("A" & rowcounter).Formula = rList1(i, 1).Text
Sheets(2).Range("B" & rowcounter).Formula = rList2(j, 1).Text
Sheets(2).Range("C" & rowcounter).Formula = rList3(k, 1).Text
Sheets(2).Range("D" & rowcounter).Formula = rList4(l, 1).Text
'This changes the text in columns A-D for the given rowcount, to the current
'iteration of the current looped value from the above lists
Next l
Next k
Next j
Next i
End Sub
This Works too and this is simpler.
Sub t()
Dim sht As Worksheet
Dim LastRow As Long, lastcol As Long
Dim i As Integer, j As Integer, k As Integer
Set sht = ThisWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
lastcol = sht.Range("A1").CurrentRegion.Columns.Count
k = 0
For i = 2 To LastRow
j = 1
k = k + 1
For j = 1 To lastcol
sht.Cells(i, j).Value = sht.Cells(1, j) & k
Next
Next
End Sub