The aim is to match two tables accroding to some specific words.
There are two tables each with 3 colums and rows(see pic).
The value A2 (table 1) are being searched range A(table 2 ). That search of this value in table 2 range A shall continue until either the value is found in table 2 range A or the loop stops when a certain Cell (e.g. A30) is reached.For case 1, if the value in table 1 A2 is found in range A in table 2, the second value (e.g.in A3 table 1) shall be taken to search for that value in table 2 range A and so on until a sertain cell is reached again.For case 2, if the value A2 (table1) cannot be found in the given range A (table2), the value in the next colum B2 shall be search for in range B(table 2) until a certain cell is reached. If this isnt successfull as well the next step is to look for the value of C2(table1) in range C(table2).
The issue is to get the do loops in the right positions so as to the search of the values (table 1) in table 2 starts always with the values in Range A (table 1) when that value ( table 1) is found.
Update: Where I am stuck is to get the multiple Do-loops right. I guess I need 3 do-loops and my problem is to get the 3rd. do-loop (the very inner one) which does the checking of the values between the tables to jump to the very first do-loop after the value in question (table1) has been found in table 1. In other word, when the value A1 in table 1 is found the do-loop goes one row further to A2 and starts again. If nothing is found in table 2, pick up the value in B2(table1) and search again but in range "B" table 2.
I have also tried to include the command "loop until" when a certain cell number e.g cells(10,1) is reached. I guess here is also a buck init.
Sub Import_Klicken()
Dim wp As Workbook
Dim ws As Workbook
Dim c As Long, r As Long, rng As Range
Dim w As Integer
Dim t As Integer
Set ws = Workbooks.Open("C:\Users\Yavuz\Desktop\a.xlsx")
Set wp = Workbooks.Open("C:\Users\Yavuz\Desktop\t.xlsx")
Do
w = w + 1
i = i + 1
t = 0
Do
t = t + 1
If ws.Sheets("Tabelle1").Cells(i, w).Value = wp.Sheets("Tabelle2").Cells(t, w).Value Then
wp.Sheets("Tabelle2").Cells(t, w).Copy
Exit Do
End If
Loop Until wp.Sheets("Tabelle2").Cells(t, w).Value = treu
i = 0
Loop
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 have 2 columns in excel, A and B. In A I have percentages (rates) and in B integers numbers (years).
rating PD year
0.39% 3
0.88% 2
1.32% 17
0.88% 1
0.26% 15
0.17% 2
0.17% 2
0.59% 2
0.59% 2
Then I have a Table in which in column F I have years and in row I have text.
Like this (the table is much bigger and years go up to 30):
Rating
Year AAA AA+ AA AA-
1 0.003% 0.008% 0.018% 0.049%
2 0.016% 0.037% 0.074% 0.140%
3 0.041% 0.091% 0.172% 0.277%
4 0.085% 0.176% 0.318% 0.465%
5 0.150% 0.296% 0.514% 0.708%
And so on (the table is much bigger than this).
So I would need a function, or a shortcut, which, for a given rate in column A and a given year in column B, gives me, in column C, the corresponding rating (AAA,AA+,AA etc.).
In the table the rates are the maximum. So if I have A1=0.50% and B1=2, then I go to look at the table, year 2 and corresponding rate, which is 0.74% (and therefore AA), because AA+ is 0.37% and is too low.
In other words, AA+ and year 2 are all the rates between 0.16% and 0.37%. And AA with year 2 are all the rates between 0.37% and 0.74%.
Do you know how I could perform this task?
Thank you very much.
For the sake of code readability, I've used two custom-made functions, alongside the main procedure shown here. Otherwise it would be a huge code-dump.
Before you begin, you have to change/check these data fields.
The (blue) data table needs to be named "scores" (or changed inside code to your own name)
Same goes for the (green) grades table - to be named "grades" and start in F1
Last but not least, the code presumes these two tables are in a sheet called "Sheet1"
So all of this needs to be changed within the code, if the names do
not match!
Now to the procedure:
Option Explicit
Private Sub run_through_scores()
Dim scores As ListObject ' table from A1
Dim grades As ListObject ' table from F1
Set scores = Sheets("Sheet1").ListObjects("scores")
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range ' for "for" loop
Dim inrow As Long ' will store in which row the year is
Dim resultColumn As Integer ' will store in which column the percentage is
'for every cell in second column of scores table (except header)
For Each cell In scores.ListColumns(2).DataBodyRange
inrow = get_year(cell).Row - 1
' ^ returns Row where result was found, -1 to accoutn for header
'using our get_interval() function, _
determines in which column is the sought percentage
resultColumn = get_interval(cell.Offset(0, -1), inrow).Column
cell.Offset(0, 1) = Sheets("Sheet1").Cells(1, resultColumn)
'write result in Column C ^
Next cell
End Sub
And to the functions:
get_year()
returns a Range Object from the "grades" table, in which we found
the matching year from our "scores" table. If the desired year is not found, it returns the year closest to it (the last table row)
' Returns a Range (coordinates) for where to search in second table
Private Function get_year(ByVal year As Variant) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim testcell As Range
Set testcell = grades.ListColumns(1).DataBodyRange.Find(year, LookIn:=xlValues)
'if found
If Not testcell Is Nothing Then
Set get_year = testcell
Else
Dim tbl_last_row As Long 'if year not found, return last row
tbl_last_row = grades.ListColumns(1).DataBodyRange.Rows.Count
Set get_year = grades.ListColumns(1).Range(tbl_last_row)
End If
End Function
And the second function:
get_interval()
returns a Range Object from the "grades" table. It compares individual cell ranges and returns upon a) if the sought percent from "scores" is less or equal (<=) then current cell percent or b) if we went through all the cells, it returns the last cell
(because it must be higher, than the maximum of specified interval)
Private Function get_interval(ByVal what As Variant, ByVal inyear As Long) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range
For Each cell In grades.ListRows(inyear).Range
'check for interval
If what <= cell And cell.Column <> 6 Then 'we don't want to check year column
Set get_interval = cell
Exit Function
End If
Next cell
' if we arrived here, at this stage the result will always be the last cell
Set get_interval = grades.ListRows(inyear).Range(, grades.ListColumns.Count)
End Function
Upon firing (invoking) the run_through_scores() procedure, we get the results as expected:
if you have any questions, please let me know :)
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.
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 ...
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