Write cell value from one column to a location specified by other cells - excel

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

Related

Deleting cells and corresponding row if criteria is met

I have a spreadsheet that has columns from A5 to AA5 and has data from A6 to AA10000. In cells A1, a user inputs a value, in cell A2 is a drop box that contains the headers of columns X to AA (A, B, C, D), and in A3 I have a dropdown of logical operators (<,>,<>,=). I'm trying to write a script that goes through columns X to AA and remove the cells that met a criteria that a user sets, e.g. user inputs a value of 300, a header "B" and a logical operator "<" and the macro goes through column Y which has the header "B" and deletes all values that are less than 300, the deletes the row from A to AA.
So far I've attempted this:
Sub removedata()
Dim ws As Worksheet
Dim rng As Range
Dim headerval As Variant
Dim sign As Variant
Dim inputval As Variant
Dim b_header As Range
Dim Cell As Range
Set ws = Worksheets("Sheet1")
Set rng = ws.Range("X5:AA5000")
Set b_header = ws.Range("X5:X5000")
inputval = cells(1, 1).Value
headerval = cells(2, 1).Value
sign = cells(3, 1).Value
For Each Cell In b_header.cells
If (headerval = "B") And (sign = "<") And (inputval < Cell.Value) Then
Cell.Delete
End If
Next Cell
End Sub
I've only attempted it for B column as a test to see whether or not I could get something to happen. When I run this Macro, it just buffers for a second and then nothing else happens.
Any help would be greatly appreciated!
Edit: Actually I realised it deletes the values that are greater than the input (Cell A1), however it only deletes a few of them each time I run it, it also moves the cells below it to its position.
The COUNTIF/COUNTIFS worksheet function accepts and interprets criteria as strings. You can use with Evaluate or directly through an application object.
Option Explicit
Sub delSpecial()
Dim lr As Long, i As Long, c As String, cl As Long
With Worksheets("sheet6")
c = .Cells(3, "A").Value & .Cells(1, "A").Value
cl = Application.Match(.Cells(2, "A").Value, .Rows(5), 0)
lr = Application.Max(.Cells(.Rows.Count, "X").End(xlUp).Row, _
.Cells(.Rows.Count, "Y").End(xlUp).Row, _
.Cells(.Rows.Count, "Z").End(xlUp).Row, _
.Cells(.Rows.Count, "AA").End(xlUp).Row)
For i = lr To 6 Step -1
If CBool(Application.CountIf(.Cells(i, cl), c)) Then
.Cells(i, "A").Resize(1, 27).Interior.Color = vbYellow
'.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

Need to get cell value and declare it to the row range automatically

Name manager using vba ...
I need to get the cell value from the column one by one and have to declare that name to that row range next to that column
Example
In column D I have the name list
I have to get that D1 value and declare that value to the row range ( E1:S1 )
Next
have to D2 ---> E2:S2
This is how it should be done for first 5 rows:
For i = 1 To 5
ThisWorkbook.Names.Add Name:=yourWorksheet.Cells(i, 4).Value, RefersTo:=yourWorksheet.Range(yourWorksheet.Cells(i, 5), yourWorksheet.Cells(i, 19))
Next
remember that the names must be unique
Try following code
Sub AddNamedRange()
Dim cel As Range
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet4") 'change Sheet4 to your sheet name
With ws
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'last row with data in Column D
For Each cel In .Range("D1:D" & lastRow) 'loop through all cell in Column D
ThisWorkbook.Names.Add cel, ws.Range(cel.Offset(, 1), cel.Offset(, 15)) 'adding named range
Next
End With
End Sub

Create table of every unique comdination from several lists

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

Compare two Excel columns and if a match found paste the value of a third column into a fourth

If cell C2 value is in the range P2:P25 then paste the value in the matching row of Column T into the same row of Column N.
View here for image.
One way, written as a standalone example and assumes that data is on Sheet1 and transfers the first match. Note that there is no error checking/handling in this example.
Sub xferNum()
Dim ws As Worksheet
Dim srow As Long, erow As Long, scol As Long, srchcol As Long
Dim rsltcol As Long, lucol As Long
Dim fndNo As Range, c As Range, lookrng As Range
Set ws = Sheets("Sheet1")
srow = 2
scol = 3
srchcol = 16
lucol = 20
rsltcol = 14
With ws
erow = .Cells(.Rows.Count, scol).End(xlUp).Row
Set lookrng = .Range(.Cells(srow, scol), .Cells(erow, scol))
For Each c In lookrng
Set fndNo = Columns(srchcol).Find(what:=c.Value)
If Not fndNo Is Nothing Then
.Cells(c.Row, rsltcol).Value = fndNo.Offset(0, lucol - fndNo.Column).Value
End If
Next c
End With
End Sub
In cell N2 put this formula: =IF(C2=P2, T2, "")
Then highlight cell N2 down to N25 and fill down. (CTRL + D).

VBA to look up value in table and copy formula

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

Resources