I am looking to update the last column of one data table with the last column of another data table. This is part of a bigger vba code. The first table spreads from A2 to column K and row "lastrpivot1". The second goes from A1001 to column K and row "lastrpivot2". Beginning with the first row of table 2 (row1001) i have to find the equivalent row in table 1 based on the values in cells A to E.
So cells A to E or frow 1001 have to be compared to cells A to E of row 2, then row 3, then row 4... until a match if found or until row "lastrpivot1". When a match is found, the value in K must return to the K value of row 1001. EX: if AtoE of row 1001 match row AtoE of row 65, then copu K65 to K1001. there shound not be more than 1 match from each table. and if there is no match there is nothing to return.
Then we start this all over for row 1002 (second row of second chart), then 1003, 1004... to lastrpivot2.
I do use vba but i do not know all the functions. this is probably why i cant figure this out.
Thnka you
In Cell K1001, try this:
=IF((A1001&B1001&C1001&D1001&E1001)=(A1&B1&C1&D1&E1),K1,"")
Then drag the formula down.
This compares the entire row 1001 to the entire row 1, which is what you're asking for.
If you intend to find the matching row like a VLOOKUP (you kind of imply this, but it is not clear that this is your intention) then you will need to use VBA to do this.
Something like (untested):
Sub MatchTables()
Dim tbl1 as Range, tbl2 as Range
Dim var1() as Variant, var2() as Variant, v as Variant
Dim r as Long, matchRow as Long
Set tbl1 = Range("A1:K500") '## Modify as needed
Set tbl2 = Range("A1001:K15001") '## Modify as needed
ReDim var1(1 to tbl1.Rows.Count)
ReDim var2(1 to tbl2.Rows.Count)
'## store the range values, conctaenated, in array variables:
For r = 1 to tbl1.Rows.Count
var1(r) = tbl1(r,1) & tbl1(r,2) & tbl1(r,3) & tbl1(r,4) & tbl(r,5)
Next
For r = 1 to tbl2.Rows.Count
var2(r) = tbl2(r,1) & tbl2(r,2) & tbl2(r,3) & tbl2(r,4) & tbl2(r,5)
Next
r = 0
For each v in Var2
r = r+1
'## Check to see if there is a complete match:
If Not IsError(Application.Match(v, var1, False)) Then
matchRow = Application.Match(v, var1, False)
'## If there is a match, return the value from column K in the first table:
tbl2.Cells(r,11).Value = tbl1.Cells(matchRow,10).Value
Else:
tbl2.Cells(r,11).Value = vbNullString
End If
Next
End Sub
Related
I'm trying to have a program that can read a range of cells which consist of 12 cells (let's say: P79, R79, T79, V79, X79, Z79, AB79, AD79, AF79, AH79, AJ79, AL79) and under those cells there are 6 cells (let's say: V81, X81, Z81, AB81, AD81, AF81), the program is looking for whether or not there are values typed in the cells within the described range.
The program should be able to read the cells from left to right on the top row and loop down to the bottom row and read that from right to left.
If all the cells in the top row have values in them, then the program breaks and doesn't read the values in the bottom row.
As the program reads the values from each cell it should create a table consisting of three columns (let's say: M88, N88, O88), the leftmost column should have the cell number (in order of cell as read by the program (whichever cell has a value first in the loop is given the number 1 and then the next cell to have a value is given number 2 etc.). The middle column should have whatever value is written in it's corresponding cell read from the range. The right column should have the value of whatever is to the right of each cell containing a value.
The first value to be read with a value should give the value "Left End" and the last value to read (whether or not it is the 12th cell to have a value in the top row or the leftmost cell to have a value in the bottom row) should give the value "Right end".
An example of what a row from the table could look like:
Cell # Cell Value Position/Left/Right
1 First Left End
This is the code I have so far:
Sub Code()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer, j As Integer, k As Integer
' First loop to compare a car to the rest after it
For i = 1 To 12
For j = i + 1 To 12
If Not IsEmpty(ws.Range("Cell_" & i)) And Not IsEmpty(ws.Range("Cell_" & j)) Then
ws.Range("B82").Offset(i).Value = j
Exit For
End If
Next j
Next i
' Loop backwards to find "Right End"
For k = 12 To 2 Step -1 '24 To 2
If Not IsEmpty(ws.Range("Cell_12")) Then
ws.Range("B82").Offset(12).Value = "Right End"
Exit For
' Has the "Right End" Follow when cars are left blank for lower row
ElseIf IsEmpty(ws.Range("Cell_" & k)) And Not IsEmpty(ws.Range("Cell_" & k - 1)) Then
ws.Range("B82").Offset(k - 1).Value = "Right End"
Exit For
End If
Next k
What I have here merely inserts a count into a cell range, what I'm trying to do is have my code actually read the cells in the range in the order I described and one at a time look at which cells have values written in them and look at which cells (with values in them) are to the right of any cell with a value and produce the table described above.
After reading your explanation, which was quite challenging I tried to recreate what you are asking.
I used cells A1:L1 with numbers 1 to 12. in the row below that A2:L2, some numbers have been added. with an if value <> "" you can see which cells contain a value.
In the second worksheet the table is made:
Sub test()
Dim a As Integer
Dim i As Integer
Dim name As String
ActiveWorkbook.Sheets(1).Activate
a = 1
For i = 1 To endcel
If Sheets(1).Range("a1").Offset(a, i - 1).Value <> "" Then
name = Sheets(1).Range("A1").Offset(a, i - 1).Value
Sheets(2).Activate
Sheets(2).Range("b2").Offset(i).Value = name
End If
Next i
End Sub
Does this help? You can adapt it a bit to your problem.
Good luck!
I am putting together some VBA code which i think needs a loop. Loops are often my biggest weakness with VBA and I need some assistance.
I have a text file which i import into an excel spreadsheet. The length of how many columns and rows and down will vary day to day.
For example today's file might have data in columns A - H, tomorrow it might be A : P. Each typical row count will be around the 200 mark, so not to long.
In essence im trying to make one long list in column A from all the data spread over multiple columns.
Im looking for a loop that checks if the column has data in it, if it does it then copies the data into the bottom of the data in column A.
So for illustration purposes say the data goes out to column G, it will copy B1, xl down, find the first empty row in A and paste, then do the same for C, stopping after column G.
I hope I’ve been clear when writing this.
Thanks in advance
Matt
You first want to loop over all columns. So a FOR loop from column B to LastColumn (which there is a function for.) Then you want to loop through all rows within that column to find the first empty row, and then substract one to arrive at the last column with data.
If Cells(row,col) = "" Then
LastRowCopy = row -1
Then you want to copy everything to A1, and keep track of the last row you posted in. So you want to have a variable that counts. Something like:
LastRowPaste = LastRowPaste + row
I could write the code for it, but perhaps you learn more by figuring it out yourself.
Edit: Also perhaps an interesting read on finding last rows and or columns is this: http://www.rondebruin.nl/win/s9/win005.htm
Edit2: You could ofcourse also use the same for finding the last column as the method I used for finding the last row. Then you just loop through the columns and see if:
If Cells(1, col) = "" Then
LastCol = col -1
Edit3:
I wrote out the entire code:
Sub copypaste()
Dim LastRowCopy As String
Dim LastRowPaste As String
Dim LastCol As String
Dim col As Integer
Dim row As Integer
LastCol = ActiveSheet.UsedRange.Columns.Count
LastRowCopy = ActiveSheet.UsedRange.Rows.Count
LastRowPaste = ActiveSheet.UsedRange.Rows.Count
For row = 1 to LastRowPaste
If Cells(row, 1) = "" Then
LastRowPaste = row
Exit For
End if
Next row
For col = 2 To LastCol
If Application.WorksheetFunction.CountA(Columns(col)) = 0 Then
LastCol = col -1
End If
Next col
For col = 2 To LastCol
For row = 1 To LastRowCopy
If Not Cells(row, col) = "" Then
Cells(LastRowPaste, 1) = Cells(row, col)
LastRowPaste = LastRowPaste + 1
End If
Next row
Next col
End Sub
I have searched the forums but I am really struggling to get part of my code to work. Basically the idea is to search sheet 1 and copy one or more columns depending on the criteria to a specific worksheet.
i.e. if sheet 1 columns 1 and 3 contain "copy 01" then copy both columns to a sheet 2 and if sheet 1 columns 2 and 4 contain "copy 02" then copy both columns to a sheet 3 etc.
I can count rows fine using the code, but can't count columns. Seems to relate to not fiding the column range but I have no ideas to fix this! Any help would be much appreciated.
'Row
Dim NR As Long
Dim d As Variant
d = ws1.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For NR = 1 To UBound(d, 1)
'column
Dim NC As Long
Dim e As Variant
e = ws1.Range(Cells(1, Columns.Count).End(xlToLeft).Column).Value
For NC = 1 To UBound(e, 1)
Thanks,
Stewart
You want this:
e = range("A1:" & split(cells(1,cells(1,columns.Count).end(xlToLeft).column).address(true,false), "$")(0) & "1").Address
The cells(1, columns.count).end(xlToLeft).column) gets the last column number (for example 13 for 'M').
Putting this into cells(1, lastcolNum) gets a cell that represents the cell in the first row of this column (for example Cell M1).
The address(true, false) method gets the cell reference with a dollar sign before the row but not before the column letter (for example "M$1"
The split function returns an array which splits the input string by the "$" character (for example array - ("M","1")
The (0) returns the 0th element in the returned array (for example "M")
Then putting this into the range function returns the range (for example) "A1:M1"
I'm not entirely sure what you're trying to do with the UBound function here. It would make more sense to make
e = cells(1,columns.count).end(xlToLeft).column
and then loop through
For N = 1 To e
As this will loop through each column.
I have a excel sheet which I am populating using a VB program. The output sheet can have variable number of rows but has 6 columns (A:F). Now I want the column G to have hex2dec of all the rows in column A. Here's an example: Say column A has 400 rows (A1:A400) then I want G1:G400 to have values HEX2DEC(A1:A400). But this is just an example the rows can vary. I have this code so far:
Sub DataMod()
Dim i As Long, R3 As Long
R3 = 1
For i = 1 To sheet.UsedRange.Rows.Count
sheet.Cells(i, 7).Formula = "=HEX2DEC" & sheet.Cells(R3, 1)
R3 = R3 + 1
Next i
End Sub
But it's not working.
Review your HEX2DEC formula string
it doesn't include the necessary ()
the Cells() would return the value of the target cell, not its address (i.e. the result would be =HEX2DEC(1234) instead of =HEX2DEC(A1) - which may or may not be a problem
you could use variable i instead of R3, they both increment from the same starting point at the same increment
I recommend to use FormulaR1C1, you do not have variants there
Sub DataMod()
Dim C As Range
For Each C In ActiveSheet.UsedRange.Columns(1).Cells
C(1, 7).FormulaR1C1 = "=HEX2DEC(RC[-6])"
Next C
End Sub
The danger of UsedRange is that it might include any header rows, so you might want to get around this by selecting the input range manually before you fire your Sub() and work with the Selection object, e.g.
For Each C In Selection.Columns(1).Cells
Try This:
Sub DataMod()
' Get the number of rows used in Column A:
Dim NumRows as Long
NumRows = Range("A1").End(xlDown).Row
' Put the formulas in Column G all at once:
Range("G1:G" & NumRows).FormulaR1C1 = "=Hex2Dec(RC1)"
End Sub
Hi I am using VB to populate data in excel. In the sheet, the column G has many cells with same numbers(and they are repeated without following any pattern). First I would like to find which entries are not unique and then keep the first occurrence in the column & delete the entire rows where repetitions are encountered. Here's an example:
As can be seen from the image, in the column G, numbers 1000 & 2200 are repeated. So need to delete entire rows 3 and 6 (keeping rows 1 & 2 where 1000 & 2200 appear first).
Here's the code which I can't get to work:
Sub Dupli()
Dim i As Long, dic As Object, v As Object
dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In sheet.UsedRange.Rows
If dic.exists(v) Then sheet.Rows(v).EntireRow.Delete() Else dic.Add(v, i)
i = i + 1
Next v
End Sub
Try something like this. I don't think you need a dictionary (unless there is some other need for it elsewhere in your code). When deleting objects, it's usually necessary to iterate backwards over the collection. This method just uses the CountIf function to test whether the cell value in column G of a specific row occurs more than once in all of column G, and deletes the row if that condition is true.
Sub Dupli()
Dim i As Long
Dim cl as Range
i = 1
For i= sheet.UsedRange.Rows.Count to 1 Step -1
Set cl = sheet.Cells(i,7) '## Examine the cell in Column G
If Application.WorksheetFunction.CountIf(sheet.Range("G:G"),cl.Value) > 1 Then
sheet.Rows(i).EntireRow.Delete
Next
End Sub
Put this in H1:
=COUNTIF(G$1:G1;G1)
Fill down to end
Make an autofilter on column G
Filter out values of 1
Select the remaining rows by row header
Right click on row header > click Delete ...