I am currently dealing with big data tables and need to made a reconciliation between two of them.
Here are what the tables look like:
1st table:
CODE1 DATE1 VALUE CODEEXIST
DATE2 VALUE
DATEx VALUE
CODE2 DATE1 VALUE CODEEXIST
DATEy VALUE
...
2nd table:
DATE1 CODE1
DATE1 CODE2
DATE2 CODE3
DATE2 CODE1
...
In fact, for example, I need to collect in the 1st table the value for CODE1 at DATE1 and to paste it in the 2nd table on the right row by matching both code and date for each CODEx and DATEy. I put a mark "CODEEXIST" on fourth column to simplify the macro creation.
Actually, I was thinking to made nested loops such as below:
Sub reco()
For i = 1 To 100
If Cells(i, 4) = "CODEEXIST" Then
For y = 1 To 100
If Sheets("Table2").Cells(y, 2).Value = Sheets("Table1").Cells(i, 1).Value Then
For Z = i To Range("D:D").Find(What:="CODEEXIST", After:=Cells(i, 4))
If Sheets("Table2").Cells(y, 1).Value = Sheets("Table1").Cells(Z, 2).Value Then
Sheets("Table2").Cells(y, 3).Value = Sheets("Table1").Cells(Z, 3).Value
End If
Next Z
End If
Next y
End If
Next i
End Sub
But code does not work because of Find function.
I also wondered if there was an easier way to get that.
Thanks for your help.
Related
I just started to learn Excel VBA so bear with me here, I have a column of ID numbers and I already figured out how to generate numbers from 1 to the end of a list as follow 1,2,3,4 etc.
The problem is how can I generate a list of ID numbers like this 1,1,2,2,3,3 etc (row 1 and row 2 should have the same incremented number)
Here is what I did to increment numbers by 1 :
Sub AddingNbr()
Columns("A").Insert
Range("A1").Value = "ID"
For i = 1 To Range("B2", Range("B2").End(xlDown)).Count
Cells(i + 1, 1).Value = i
Next
End Sub
Can you try this?
Sub AddingNbr()
Columns("A").Insert copyorigin:=xlFormatFromRightOrBelow
Range("A1").Value = "ID"
For i = 1 To Range("B2", Range("B2").End(xlDown)).Count
Cells(i + 1, 1).Value = WorksheetFunction.Ceiling(CDec(i) / CDec(2), 1)
Next
End Sub
well all this is fine, but I have a nice way to do incrementation of values in excel with the one format we want. This formula really helps espacially when you want to use forms. That's the formula:
="LIVR"&TEXT(IF(A1=$A$1;0;MID(A1;5;3)+1);"000") it makes that
LIVR000
LIVR001
LIVR002
LIVR003
...
LIVR999
I have a csv file on excel that is ~CU for the column.
And the row gets keep updated (as of now it's 2606).
I'm trying to
delete all row that are before today's date as recorded on column D
no typing/text box/human input for today's date.
Sub deleterows()
lastrow = Cells(Rows.Count, 4).End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, 4).Value < *numeric value* Then Rows(i).EntireRow.Delete
Next i
End Sub
For dates (and currency), its always recommended to use Value2 instead of Value.
MSDN:
The only difference between this property and the Value property is
that the Value2 property doesn’t use the Currency and Date data types.
You can return values formatted with these data types as
floating-point numbers by using the Double data type.
So all you need to do is change this part If Cells(i, 4).Value < *numeric value* Then
With this If Cells(i, 4).Value2 < Date Then
and it evaluate as true if Column D is older than today.
I have tried, and been unable to find any sample VBA code that fits my needs. What I'm trying to do is find duplicate matches between two columns and consolidate them with respect to a third column, then in a fourth column show how many instances of the duplicate existed originally.
The original data:
The ideal output after removing duplicates:
As you can see, in the output I have 1 instance of 1 in Column A, a in Column B, retained the first value the duplicates started at in Column C and express 2 occurences of the duplicates in Column D. Can anyone point me in the right direction? Any help would be greatly appreciated.
the below code will find the number of occurrences in fourth column and remove the duplicates
Sub foo()
row_count = 20
For i = 2 To row_count
Count = 1
For j = 2 To row_count
If i <> j And Cells(i, 1).Value <> "" Then
If Cells(i, 1).Value = Cells(j, 1).Value And Cells(i, 2).Value = Cells(j, 2).Value Then
Rows(j & ":" & j).Delete Shift:=xlUp
Count = Count + 1
j = j - 1
End If
End If
Next j
If Count > 1 Then
Cells(i, 4).Value = Count
End If
Next i
End Sub
I am trying to find code that looks at two criteria in spreadsheet1 and finds a row that corresponds in spreadsheet2 and returns a third piece of data in spreadsheet2 to spreadsheet1. I need to do this in vba because it loops, because I will be done it again and again, and because the data from spreadsheet2 imports from another database and will change over time. If possible it would be nice if the code also allowed for identifying a 3rd criteria on spreadsheet2.
Example is:
Spreadsheeet 1
Product ID ActCode: A0003
11111
12345
22222
...
Spreadheet 2
ProductID ActivityCode DateDue
11111 A0001 7/15/15
11111 P7530 7/30/15
11111 A0003 8/1/15
12345 A0003 12/15/15
12345 A0007 1/1/15
22222 A0001 2/1/15
...
Where I want Spreadsheet1 to end up:
Spreadsheeet 1
Product ID ActCode: A0003
11111 8/1/15
12345 12/15/15
22222 -
...
I have tried a ton of things over the past few days. 1) vlookup/index/match combos that have never really worked, 2) filtering spreadsheet2 by productID and activitycode and then copying to spreadsheet1 the visible cells - this works but is very slow. I will be doing this for many activity codes, so I need something faster (I can post the code if you want to see it). I am currently trying a loop within a loop. Not sure if this is the best way but here is the code I have so far. It does copy some dates over, but not the right ones - its also a bit slow.
Sub test()
Application.ScreenUpdating = False
Sheets("Spreadsheet1").Select
Range("A2").Select ' Select A = the column with the product ID in it
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Dim ConceptAct As String
ConceptAct = "A0003"
Dim ProductID
ProductID = ActiveCell.Value
Dim ConcDue
Sheets("Spreadsheet2").Select
Range("A2").Select 'The column with the ProductID in it
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = ProductID And ActiveCell.Offset(0, 1).Value = ConceptAct Then
ConcDue = ActiveCell.Offset(0, 2).Value
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
Sheets("Spreadsheet1").Select
ActiveCell.Offset(0, 1) = ConcDue
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub
Why won't Index/Match work? I was able to get, I think, your solution with an Index/Match formula entered as an array. Here's a screenshot of everything:
Index/Match can use multiple criteria for looking things up, just connect these with &, both in the first and second parts of the Match(), and hit CTRL+SHIFT+ENTER to enter as an array. This formua will look at the product ID, then that ActCode, return the date.
Is this what you were looking for?
I'm unclear on why a two-column criteria formula using native worksheet functions is not apprpriate but a User Defined Function (aka UDF) would be one avenue to pursue from a VBA point of view.
Function udf_Get_Two(sCode As Range, rCodes As Range, _
sProd As Range, rProds As Range, _
rDates As Range)
Dim vCode As Variant, rw As Long, m As Long
'quick check to see if there is anything to find
If CBool(Application.CountIfs(rCodes.Columns(1), sCode.Value, _
rProds.Resize(rCodes.Rows.Count, 1), sProd.Value)) Then
rw = 0
For m = 1 To Application.CountIf(rCodes.Columns(1), sCode.Value)
rw = rw + Application.Match(sCode.Value, rCodes.Columns(1).Resize(rCodes.Rows.Count - rw, 1).Offset(rw, 0), 0)
If rProds(rw, 1) = sProd Then
udf_Get_Two = rDates.Cells(rw, 1).Value
Exit Function
End If
Next m
End If
End Function
Use like any other worksheet formula. Example:
=udf_Get_Two(A2, Sheet2!$A$2:$A$7, $C$1, Sheet2!$B$2:$B$7, Sheet2!$C$2:$C$7)
Note that the returned values are raw. The cells should be formatted as m/d/yy or as you prefer.
this is my first attempt to create a macro, so sorry in advance for my lack of knowledge on the subject. I've attempted to follow tutorials and examples online, but I'm not having a lot of luck.
I want to create a macro that can move an entire row above the previous row if certain values in the row are less than the respective values in the previous row.
I tried posting an image of the excel sheet I'm working with, but I do not have enough reputation.
The logic would be something like this:
IF--- Column2(row_i) < Column2(row_i-1)
AND--- Column3(row_i) < Column4(row_i-1)
THEN
Insert a blank row above row_i-1
Copy row_i and paste it in the blank row
Delete the original row_i
Return to top of list and begin search again
ELSE--- Move to row_i+1}
Here is what I currently have:
Sub PrioritySort()
Dim i As Integer
For i = 11 To 17
If Cells(i, 2) < Cells((i - 1), 2) Then
If Cells(i, 3) < Cells((i - 1), 4) Then
//insert row_i above row_i-1
Else
Next i
End Sub
If anyone would be willing to help, it'd be greatly appreciated!
//insert row_i above row_i-1 is something like:
Rows(i).Select
Selection.Cut
Rows(i-1).Select
Selection.Insert Shift:=xlDown
...Also remember an "End If" to close out your multiline If statements.
Let's take a sample:
column1 column2 column3 column4
4 4 4 4
3 3 3 3
2 2 2 2
1 1 1 1
We want to reordering this. Our end result should look like this
column1 column2 column3 column4
1 1 1 1
2 2 2 2
3 3 3 3
4 4 4 4
Macro
Sub Macro3()
Dim NoOfTimesChanged As Integer
' attempt to reorder rows and find out if reordering
' was done or not
NoOfTimesChanged = ReOrderRows()
' keep on reording until there is nothing else to reorder
Do While NoOfTimesChanged > 0
NoOfTimesChanged = ReOrderRows()
Loop
End Sub
Function
' Reorder all rows based on certain condition
' Returns: 0 or 1 to the caller
' 0 is returned when no reording was necessary
' 1 is returned when reordering was necessary
Function ReOrderRows() As Integer
Dim ReOrdered As Integer
ReOrdered = 0
' Lets start from row #3 and compare with row #2
' Remember that row #1 has headers
For i = 3 To 5
' IF--- Column2(row_i) < Column2(row_i-1)
' AND--- Column3(row_i) < Column4(row_i-1)
If Cells(i, 2) < Cells(i - 1, 2) And _
Cells(i, 3) < Cells(i - 1, 4) Then
' select the current row and cut it
Rows(i & ":" & i).Select
Selection.Cut
' select the above row insert the cut-rows
' making sure the current selection is moved down
Rows(i - 1 & ":" & i - 1).Select
Selection.Insert shift:=xlDown
' mark this flag to 1 so as to inform
' the caller function that reordering
' was performed
ReOrdered = 1
End If
Next i
ReOrderRows = ReOrdered
End Function
Try this out. Note that I have used only 4 rows + 1 header row and therefore the for loop goes from 3 to 5. You can change this code as you desire.