I would like to notify something about this macro and about this post
in this macro
Code:Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row ' it will be ws1, not ws2 bcoz by using ws1 i am getting correct output
plz have a look to the sample file & macro too...
Problem is Solved according to me But any more suugesstion is welcome
Hi
You change may work sometimes, but sometimes with different data it might not work.
In any case it is a stupid thing to do….
Let me explain…
It should be very, very simple to understand:
Consider your uploaded files ….
The range that you search in is in Ws2 (H2(SAMPLE).xlsb ) . Your data goes up to row 36
36 comes from
Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row
You take each data from Ws1 (1(sample) ) and look in that range for a match. You have data in Ws1 up to 142
142 comes from
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
That above is all correct. It is as it should be.
If you use
Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
then you search in the range up to 142 in Ws2
As long as Lr1 is larger than Lr2 then it may work. But your macro may work slower, because you are searching in extra cells that are empty. You do not need to search in empty rows
If Lr1 is less than Lr2, then your macro may not work.
Let me try to explain again , with example of smaller data :
Lets say you have 3 lines of data ( 4 rows ) in Ws2, and 10 rows in Ws1
If you use Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row , then you will search in this range
_____ Workbook: H2(SAMPLE).xlsb ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col A 2 ADANIPOWER 3 AMARAJABAT 4 ASIANPAINT
If you use this Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row , then you will search in the range
_____ Workbook: H2(SAMPLE).xlsb ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col A 2 ADANIPOWER 3 AMARAJABAT 4 ASIANPAINT 5 6 7 8 9 10
So there will be no problems , but you are searching over a greater range than you need. So this might make your macro run slower, since you search more rows than you need to.
But now consider another example : Consider that your data in Ws2 has 7 rows, but there are only 3 rows of data in Ws1
If you use this Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row , then you will search in this range
_____ Workbook: H2(SAMPLE).xlsb ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col A 2 ADANIPOWER 3 AMARAJABAT 4 ASIANPAINT 5 AMBUJACEM 6 APOLLOHOSP 7 APOLLOPIPE
So you will search as you should in all values in Ws2
But if you use this Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row , then you will be searching over this reduced range:
_____ Workbook: H2(SAMPLE).xlsb ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col A 2 ADANIPOWER 3 AMARAJABAT
So you are not searching in all the values in Ws2, so you may get the wrong results!
You may choose to use Ws1 instead of Ws2. It is your choice. This will help you Fail in the future when sometimes later you will get the wrong results:
It may fail sometimes if there are more rows of data in Ws2 then in Ws1.
If it does not fail, the macro may work slower then it needs to , because it is searching in cells that it does not need to.
Alan
Plz run this macro Doc sir & Plz see the output
This is the updated macro which u have provided Doc Sir & i sent u the sample file today plz run & see the output u will understand (This macro is not giving me the desired output)
Code:Sub STEP3() ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14587&viewfull=1#post14587 https://eileenslounge.com/viewtopic.php?f=30&t=34937
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1) ' First worksheet tab counting from the left
Set Ws2 = Wb2.Worksheets.Item(2) ' Second worksheet tab cunting from the left
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws1
Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws2
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "") ' The range that will be searched in
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "") ' The range from which data will be looked for in rngSrch
Dim Cnt As Long ' For each rngDta.Item(Cnt)
For Cnt = Lr2 To 1 Step -1 ' We take -ve steps = we go backwards. This is important when deleteing things. See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match
' If it was Not Nothing then there was a match. So we do nothing
Else ' The attempt at a match failed, we got Nothing this is the condition to delete
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
End If
Next Cnt ' Next rngDta.Item(Cnt)
Wb1.Close SaveChanges:=True ' Save the file and close it
Wb2.Close SaveChanges:=True ' Save the file and close it
End Sub
When I run the macro it does the following:
It considers values in Ws1 column B , ( that is the data range, rngData )
If it finds that value in Ws2 column A , then it does nothing
If it does not find that value, then it deletes that row in Ws1
With your data, it does not find ADANIPORTS or ADANIENT or ACC , so those data rows in Ws1 are deleted.
Looking at your Output worksheet, it would appear that you should be deleting many more rows in Ws1
I have tried to look back through the chaos of duplicated cross postings that you have done to try and geuss what you want….
The last macro I gave you is looping through the data in Ws1 using this code line
For Cnt = Lr2 To 1 Step -1
Most of the last macros you posted here and elsewhere were doing that……….
That is going to only loop through the data in Ws1 up to 36 ( because Lr2 is 36 )
I will take a guess that you want to loop through all the data in Ws1 , because I can see no reason why you should loop through just some of your data.
My guess is that you should be doing this
For Cnt = Lr1 To 2 Step -1
So
Try this next macro version:……
https://excelfox.com/forum/showthrea...ll=1#post14636
So finally what this macro is doing. In English:
Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
If a match is found, then nothing is done. If a match was not found, then the entire row containing the data value in Ws1 is deleted
Hi Experts,
If column A of H2.xlsx matches with column B of 1.xls then delete that entire row by vba
macro will be placed in macro.xlsm and files can be located anywhere in the pc so hardcoded the path so that i can change it as per my needs
Thnx for the Help
sample file attached below
Problem Solved
Awesome Doc Sir
Thnx Alot for helping me in solving this Problem Sir
Have a Awesome Day
Your description is bad.
You have not said what worksheets are to be considered. It appears to be the second worksheet in "H2(SAMPLE).xlsx" and the first worksheet in "1(sample).xls"
So your last question I answered for you this morning was… , in English :
_ Sub Step3b() https://excelfox.com/forum/showthrea...ll=1#post14636
Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
If a match is found, then nothing is done. If a match was not found, then the entire row containing the data value in Ws1 is deleted
Now, the question here is….
Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
If a match is not found, then nothing is done. If a match is found, then the entire row containing the data value in Ws1 is deleted
It is sometime very hard to believe that you are incapable of figuring out the changes for yourself!
If you had left the ' comments on my macro then the changes would have been obvious
Previous macro,
Sub STEP3b() If a match is found, then nothing is done. If a match was not found, then the entire row containing the data value in Ws1 is deleted
New Macro for If a match is not found, then nothing is done. If a match is found, then the entire row containing the data value in Ws1 is deletedCode:If Not MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match
' If it was Not Nothing then there was a match. So we do nothing
Else ' The attempt at a match failed, we got Nothing this is the condition to delete
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
End If
OrCode:If Not MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match. Not Nothing is the condituion of a match, the condition to delete the row
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
Else ' The attempt at a match failed, we got Nothing this is the condition to do nothing
' If it was Nothing then there was not a match. So we do nothing
End If
Code:If MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match. Nothing is the condituion of no match, the condition to do nothing
' If a match is not found, then nothing is done
Else ' The attempt at a match was succesful, we got a match, the condition to delete the row
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
End If
Full macros here:
https://excelfox.com/forum/showthrea...ll=1#post14641
Alan
Thnx Alot Doc Sir for helping me in solving this problem
Problem Solved
Have a Awesome Day
From next Time, i will try to provide as much info as much i can provide
Problem 1 is very simple. You must have done this already hundreds of time! There is only one very important thing to remember: When looping to delete things, you must always loop backwards : https://excelfox.com/forum/showthrea...ll=1#post12902
Before:
_____ Workbook: ABC-PROBLEM1.xls ( Using Excel 2007 32 bit )
Worksheet: 1-Sheet1
Row\Col A B C D E F G H I J K 1 Exchange Symbol Series/Expiry Open High Low Prev Close LTP 2 NSE ACC EQ BUY 3 NSE ADANIENT EQ BUY 4 NSE ADANIPORTS EQ BUY
Run macro:
After:Code:Sub DeleteRowifHighequalsLow_2() ' Problem 1 https://www.excelforum.com/excel-programming-vba-macros/1321862-delete-entire-row-by-vba.html https://excelfox.com/forum/showthread.php/2582-delete-entire-row-by-vbA
Rem 1 Worksheet info
Dim WbABC As Workbook, WsABC As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\ABC-PROBLEM1.xls")
Set WsABC = WbABC.Worksheets.Item(1)
Dim LrABC As Long: Let LrABC = WsABC.Range("E" & WsABC.Rows.Count & "").End(xlUp).Row ' Make Lr dynamic https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466
Dim arrABC() As Variant
Let arrABC() = WsABC.Range("A1:K" & LrABC & "").Value
Dim Cnt As Long
For Cnt = LrABC To 2 Step -1 ' When looping to delete things, you must always loop backwards : https://excelfox.com/forum/showthrea...ll=1#post12902
If arrABC(Cnt, 5) = arrABC(Cnt, 6) Then
WsABC.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
Else
End If
Next Cnt
End Sub
_____ Workbook: ABC-PROBLEM1.xls ( Using Excel 2007 32 bit )
Worksheet: 1-Sheet1
Row\Col A B C D E F G H I J K 1 Exchange Symbol Series/Expiry Open High Low Prev Close LTP 2 NSE ACC EQ BUY 3 NSE ADANIENT EQ BUY 4
Problem 2
See next post
From last post
Problem 2
You have not given me an After, and once again the explanation is bad. - you did not yet answer maniacb at excelforum.... https://www.excelforum.com/excel-pro...ml#post5365612
I will have to assume that this:
If column B of DEF.xlsx matches with Column I of ABC.xls then delete that entire row
Is supposed to mean this
If column B of DEF.xlsx matches with Column I of ABC.xls then delete that entire row of ABC.xls
In other words, something we have done many times already….
We consider the data in column I of ABC.xls from row 2. We try to find ( match ) that data to any row of data in column B of DEF.xlsx
If we do have a match then we delete the entire row containing the considered data from Column I of ABC.xls
I will do the first solution, Problem2a) slightly differently ,because I am getting bored answering almost the same question over and over again…
I am using vba arrays because for your values work that is the best approach in Excel ( https://excelfox.com/forum/showthrea...ll=1#post14628 )
I do not delete rows, so I do no backward looping
Instead I collect indices of the rows I want to have = rows which are not deleted. For you test data, the rows I want are 1 4 5 6 7 8 9 ( rows 2 and 3 ) are not wanted – you want to delete them )
Finally the macro replaces the original range with a new one containing just the rows you want
I also did a more conventional solution Problem2b like the ones you have seen a lot of in the last few days. It deletes the rows ( rows 2 and 3 )
Before
_____ Workbook: DEF PROBLEM 2.xlsx ( Using Excel 2007 32 bit )
Worksheet: DEF
Row\Col A B C D E F G H I J K 1 NSE 22 6 > 12755 A GTT 2 NSE 25 6 < 13448 A GTT
_____ Workbook: ABC.xls ( Using Excel 2007 32 bit )
Worksheet: 1-Sheet1 Problem 2
Row\Col A B C D E F G H I J K 1 Exchange Symbol Series/Expiry Open High Low Prev Close LTP 2 NSE ACC EQ 1265 1282.7 1246.5 1275.3 1247 22 BUY 14104.65 3 NSE ADANIENT EQ 151.85 165.45 151.4 151.85 152.35 25 BUY 3235.03 4 NSE ADANIPORTS EQ 348 348 348 346.55 338.85 15083 BUY 3539.747 5 NSE APOLLOHOSP EQ 1359 1391 1339 1355.65 1346.8 157 BUY 2994.65 6 NSE APOLLOPIPE EQ 351.95 351.95 340 350.8 347.2 14361 BUY 4339.566 7 NSE ASHOKLEY EQ 52.1 52.35 51 52.7 51 212 BUY 7051.82 8 NSE AUROPHARMA EQ 789 805.45 775.35 796.95 782.4 275 BUY 3608.73 9 NSE AXISBANK EQ 426.5 435.55 408.7 427.45 413.5 5900 BUY 255575.45
After
_____ Workbook: ABC.xls ( Using Excel 2007 32 bit )
Worksheet: 1-Sheet1 Problem 2
Row\Col A B C D E F G H I J K 1 Exchange Symbol Series/Expiry Open High Low Prev Close LTP 2 NSE ADANIPORTS EQ 348 348 348 346.55 338.85 15083 BUY 3539.747 3 NSE APOLLOHOSP EQ 1359 1391 1339 1355.65 1346.8 157 BUY 2994.65 4 NSE APOLLOPIPE EQ 351.95 351.95 340 350.8 347.2 14361 BUY 4339.566 5 NSE ASHOKLEY EQ 52.1 52.35 51 52.7 51 212 BUY 7051.82 6 NSE AUROPHARMA EQ 789 805.45 775.35 796.95 782.4 275 BUY 3608.73 7 NSE AXISBANK EQ 426.5 435.55 408.7 427.45 413.5 5900 BUY 255575.45 8 9
Macros
Here 2a
https://excelfox.com/forum/showthrea...ll=1#post14645
Or
Here 2b
https://excelfox.com/forum/showthrea...ll=1#post14646
Thnx Alot Doc Sir for helping me in solving this problem
Have a Awesome Day
Problem Solved
Problem 2 solution has minor issue but i corrected it
Code:' Problem 2a with VBA arrays ' https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14645&viewfull=1#post14645
Sub SelectOutRowsNotToBeThere_SelectTheRowsIWant() ' Problem 2 ' https://excelfox.com/forum/showthread.php/2582-delete-entire-row-by-vbA
Rem 1 Worksheet data info
Dim WbABC As Workbook, WsABC As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\ABC.xls")
Set WsABC = WbABC.Worksheets.Item(1)
Dim WbDEF As Workbook, WsDEF As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx") ' this line WbDEF will be there i corrected it
Set WsDEF = WbABC.Worksheets.Item(1)
Dim LrABC As Long, LrDEF As Long
Let LrABC = WsABC.Range("A" & WsABC.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsABC
Let LrDEF = WsDEF.Range("B" & WsDEF.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsDEF
'Dim arrIn() As Variant
' Let arrIn() = WsABC.Range("A1:K" & LrABC & "").Value2 ' Instead of this i will use Cells in the "magic code line"
Dim arrSrch() As Variant
Let arrSrch() = WsDEF.Range("B1:B" & LrDEF & "").Value2
Dim arrDta() As Variant
Let arrDta() = WsABC.Range("I1:I" & LrABC & "").Value2
Rem 2 get array of indicies for wanted rows
Dim Cnt As Long
Dim strRws As String: Let strRws = "1" ' The string for the indicies will always want the first header row
For Cnt = 2 To LrABC
Dim MtchRes As Variant
Let MtchRes = Application.Match(arrDta(Cnt, 1), arrSrch(), 0)
If IsError(MtchRes) Then Let strRws = strRws & " " & Cnt ' for no match, we want to not delete this row, so do not select it out In other words this code line collects the rows not wanted to be deleted = rows wanted
Next Cnt
Rem 3 Get the indicies in a vertical array, since the "magic code line" needs a vertical array
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare) ' This gives us a 1 dimensional "horizontal" array ( starting at indicie 0 )
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1) ' +1 is needed because the
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
Rem 4 get the output array from "magic code line" :
Dim Clms() As Variant
Let Clms() = Evaluate("=Column(A:K)") ' columns 1 2 3 m4 5 6 7 8 9 10 11
Dim arrOut() As Variant
Let arrOut() = Application.Index(WsABC.Cells, RwsT(), Clms()) ' Magic code line http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
Rem 5 replace worksheet data with modified data arrayOut
WsABC.Cells.ClearContents
Let WsABC.Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut() ' We can paste in one go the contents of an arrasy to a worksheet range
Rem Close save workbooks
WbABC.Close Savechanges:=True ' Save the file and close it
WbDEF.Close ' Close file. No changes were made
End Sub
' Conventional macro for comparison: https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14646&viewfull=1#post14646
correct, I made the same mistake in both macros.
I corrected it just now in both macros.
( https://excelfox.com/forum/showthrea...ll=1#post14645
https://excelfox.com/forum/showthrea...ll=1#post14646 )
Well spotted!
No Problem Doc Sir, it was a minor error
Thnx For the Help
If column C has blank cell then delete that entire row
Hi Experts,
I am looking for a macro that will do the things mentioed below
There are two different files(file name book1.xlsx & book2.xlsx)
If column C has a blank cell then delete that entire row by vba in both the file(check in both the file one by one & if they have a blank cell in column C then delete that entire row by vba in both files)
both files may be located at any place in the pc so the path should be hardcoded in the macro(so i can change it as per my needs)
Thnx For the Help
No Problem Doc Sir, it was a minor error
Thnx For the Help
_ Are both files located at the same place? ( Can be anywhere, but is it the same place for both files or a different place?)
_ And is it always only one worksheet, the first one for every file?
_ Are both files located at the same place? ( Can be anywhere, but is it the same place for both files or a different place?)
_ And is it always only one worksheet, the first one for every file?
No Doc Sir, both files are not located at same place
yes the first sheet Doc Sir
OK, I will post again when I have the solution for you
I will take a guess that you want to open the files.
I am assuming that columns always go to column U. If that is not the case, then you need to make the last column dynamic if the columns used can vary for different files. ( If you need to do that, and can’t figure out how, then I will do that for you later, probably tomorrow )
I have used the same ways as I did in the last macro for you, ( to solve Problem 2 https://excelfox.com/forum/showthrea...ll=1#post14648 )
I do not delete any rows
Instead I collect indices of the rows you want to have = rows which are not to be deleted. For you test data, the rows you want are 2 3 and 4
Finally the macro replaces the original range with a new one containing just the rows you want
Before
_____ Workbook: Book2.xlsx ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col NSE EQ BAJAJ NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ AMARAJABAT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ ASIANPAINT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA
_____ Workbook: Book1.xlsx ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col NSE EQ ADANIPOWER NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ AMARAJABAT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ ASIANPAINT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA
After
_____ Workbook: Book2.xlsx ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col NSE EQ BAJAJ NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ AMARAJABAT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ ASIANPAINT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA
_____ Workbook: Book1.xlsx ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col NSE EQ ADANIPOWER NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ AMARAJABAT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA NSE EQ ASIANPAINT NA NA NA SELL MARKET NA CLI MIS DAY WC5758 NA NA
Macro here https://excelfox.com/forum/showthrea...ll=1#post14657
Note: You must change this line
To something like thisCode:Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
Code:Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx") '
Doc Sir the data can be more than in column U, there is a chance the data will be till column Z or more than that
I am trying to make the last column Dynamic & if I unable share the details then plz look at it tomorrow & help me for the same
Thnx Alot Doc Sir for helping me in solving the same
Have a Awesome Day
I am trying to make the last column Dynamic & if I unable share the details then plz look at it tomorrow & help me for the same
Thnx Alot Doc Sir for helping me in solving the same
Have a Awesome Day
Hi
Making the Last column , Lc, dynamic in your last macro , Sub OnlyHaveRowsWhereColumnCisNotEmpty()
In this case, the usual way we did it before, something like
Ws.Cells.Item(1, Ws.Columns.Count).End(XlToLeft).Column
or like
Ws.Cells.Item(3, Ws.Columns.Count).End(XlToLeft).Column
will not work sometimes
it will not work if , in those examples , row 1 or row 3 was empty, which, based on your test data, might have been the case.
( I am assuming in all this work that rows other than row 1 might have an empty cell in column C, and , like your test data , an entire row might be empty…… )
We can try something else
We can use the UsedRange property's available properties of
the start column, UsedRange.Column
and the columns count UsedRange.Columns.Count
Using
UsedRange.Columns.Count- UsedRange.Column + 1
That is half the solution to the dynamic column problem. It returns us the last column number, which for yout example files , should be 21 ( Column Letter U )
The next part of this problem is that my macro, Sub OnlyHaveRowsWhereColumnCisNotEmpty() , needs to use the column Letter , not the column number.
You need to include this function , ( which you have had this function already from me many times before )
That function mustCode:' https://excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort-Last-Row?p=7214#post7214
Public Function CL(ByVal lclm As Long) As String ' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
Either
Go in the same code module as Sub OnlyHaveRowsWhereColumnCisNotEmpty[color=lightgreyDynamicColumns[/color]()
Or
It can go in any other module: Just to illustrate that point I have uploaded two sample workbooks,
macro1.xlsm has the function and the next macro version in it in the same code module.
Macro2.xlsm has them in separate modules, like this:
MainMacroAndFunctionCodeModules.JPG : https://imgur.com/siBZVuz
Attachment 3312
The two changes for the dynamic column is
_1 a new line
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
_2 Modify the column indicia code line, Clms() = Evaluate("=Column(A:U)")
Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
_3 You need to include the function CL( )
The next macro version and function, Sub OnlyHaveRowsWhereColumnCisNotEmptyDynamicColumns() , is here:
https://excelfox.com/forum/showthrea...ll=1#post14663
https://excelfox.com/forum/showthrea...ge29#post14663
and also in the files:
macro1.xlsm : https://app.box.com/s/tl3rs9693jwuv9c2w36ok8fpaewuf0ta
macro2.xlsm : https://app.box.com/s/t35238lm19bj6y0p6m6p68uaknsdf37z
Alan
Thnx Alot Doc Sir for helping me in solving this problem
Problem Solved
Have a Awesome Day Bro
Only a small thing is missing, i want to save the changes also but i am unable to make it
i mentioned wb.save but it is not successful, So i need help regarding the same
What exactly did you try? You must take your time and explain everything more carefully, or you waste my time with lots of unecerssary replies...
I want to save the output sir
the macro is runing perfect but in the last we have to mention lines that will save the changes
You did not answer my question
Quote:
Originally Posted by DocAElstein
Code:Sub STEP8()
Dim arrWbs() As Variant
Let arrWbs() = Array("C:\Users\WolfieeeStyle\Desktop\A.xlsx", "C:\Users\WolfieeeStyle\Desktop\Files\B.xlsx")
Dim Wb As Workbook, Ws As Worksheet
Dim Stear As Variant
For Each Stear In arrWbs()
' 2a Worksheets data info
Set Wb = Workbooks.Open(Stear)
Set Ws = Wb.Worksheets.Item(1)
Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
Dim Cnt As Long
For Cnt = 1 To LrC
Dim strRws As String
If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
Next Cnt
Let strRws = Left(strRws, Len(strRws) - 1)
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
Dim Clms() As Variant
'
Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())
Ws.Cells.ClearContents
Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()
Let strRws = ""
Next Stear
arrWbs.Save 'Here we have to mention lineswhich will save the changes done by the macro, I tried by wb.save also & arrWbs.Save also but it was not correct
arrWbs.Close 'Here we have to mention lineswhich will close all the files opened by macro
End Sub
Public Function CL(ByVal lclm As Long) As String
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
Plz see the code & my remarks
I have mentioned the problem Doc Sir in the remarks
OK, you seem to be trying to save all the files at once. That is not so easy to do.
arrWbs() is just text. Inside it, it just looks like this:
" C:\Users\WolfieeeStyle\Desktop\A.xlsx _ , _ C:\Users\WolfieeeStyle\Desktop\Files\B.xlsx "
You can’t apply any property action command to a piece of text
In my macro, each time the loop is done, the Workbook object, Wb is made from the string path and name of a workbook, ( which is held each time in the variable Stear ).
You know how to save and close a single Workbook with like
Wb.Save
Wb.Close
So you need to have those code lines inside the loop which is done For every workbook
So then Each time it will save Each workbook
Code:Wb.Save
Wb.Close
Next Stear
End Sub
Example in this file:
Macro2.xlsm : https://app.box.com/s/t35238lm19bj6y0p6m6p68uaknsdf37z
That’s all I have time for today.
Before you post any questions again, think more carefully , and read what I write…
Problem Solved
Thnx Alot Doc Sir For helping me in solving this Problem Sir
Have a Great Day
Hi Experts,
This code has limitation of LR1=5000 & LR2= 5000(plz remove the limitations of this macro)Code:Sub STEP6()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets(1)
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Files\Error.xlsx")
Set Ws2 = Wb2.Worksheets(1)
Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
& one more issue is there with this macro
I am sending the sample file plz run the macro & see the output
If error.xlsx is blank sheet then it is giving something different output plz see
.
Avinash,Quote:
Originally Posted by fixer
Your apparent ability or unwillingness to understand or remember anything is now at such a high level that
Either
_1) You are trying deliberately as hard as possible to annoy us
or
_2) If _1) is not correct, then you really should now see a Doctor or Psychologist, since you are very likely seriously mentally Ill
We have had the making last row dynamic issue over and over again. Even just recently almost an identical question from you was answered, and the macro was also almost identical!!!:
https://eileenslounge.com/viewtopic.php?f=30&t=34937
https://eileenslounge.com/viewtopic....271316#p271316
https://excelfox.com/forum/showthrea...ll=1#post14565
Edit: And you posted this same question a few days before.. Bro you are in a total mixed up mess!!!
(https://excelfox.com/forum/showthrea...ll=1#post14599 )
I have no idea what you are asking. I have no idea what it is that you are trying to say .Quote:
Originally Posted by fixer
Possibly it is something to do with problem 2 here:
https://excelfox.com/forum/showthrea...ll=1#post14565
The problem is your usual incompetence. You mix everything up, and half the time either don’t know what you want or cannot explain what you want. This is not a VBA issue. This is a problem with your brain that needs medical help.
Alan
Edit.. and here we go yet once again .... same question
https://eileenslounge.com/viewtopic....272085#p272085
_.. same wrong answer...
https://eileenslounge.com/viewtopic....272094#p272094
( wrong caslculation of Lr2 )
_... and yet agin you think its right ... and another set of duplicated cross postings will begin when you realise yet agin that it is wrong... Bro - you need medical help, fast! NO JOKE!
Hi Experts,
I want to make this macro Lr as dynamic
Code:Sub STEP4()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx")
Dim Ws1 As Worksheet, WS2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set WS2 = Wb2.Worksheets.Item(4)
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
Dim rngSrch As Range: Set rngSrch = WS2.Range("B1:B" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("I2:I" & Lr1 & "")
Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(What:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
Thnx For the Help
I changed the lr for this problem Plz see is it perfect?Code:Sub STEP5()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long:
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
Else
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
Both macros are givng perfect Result But u have recommended it will work sometimes & may be sometimes it will not work thats y i posted this question
Code:Sub STEP6()
Dim Wbm As Workbook: Set Wbm = ThisWorkbook
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\9.15\Files\Error.xlsx")
Set Ws2 = Wb2.Worksheets.Item(1)
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets.Item(1)
Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
Code:Sub STEP9()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets(1)
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\9.15\Files\Error.xlsx")
Set Ws2 = Wb2.Worksheets(1)
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
Let Lr2 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
Dim Cnt As Long
If ActiveSheet.Cells(1, 1) = "" Then
Wb1.Close SaveChanges:=False
Wb2.Close SaveChanges:=False
Exit Sub
End If
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
This is crazy!! I have told you so many times!!!
Lr1 is for Ws1
Lr2 is for Ws2
Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
Lr2 = Ws2.Range("B" & Ws2.Rows.Count).End(xlUp).Row
If a macro like those originated from me, which it may well have, then the basic idea , originally, would have been this:
A row is possibly being deleted in a fairly bog standard conventional worksheet code line in a Loop. Hence it must Loop backwards… Based on the initial given requirement, the macro was doing this: A column of data in a worksheet is gone through/looped. That column would be the rngDta. We can see that in the Loop since at each Loop as the Loop count variable, Cnt , changes, we have the next back/down Item in the rngDta as What:= is being looked for rngDta.Item(Cnt)
In these macros , it seems that the data is in Ws1 , and the rngDta from a dynamic last row, is given by something of the form
Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
That is the data that is gone through/Looped , so the Looping should be done like
__For Lr1 To 1 Step -1
The range in which each data item is looked for is rngSrch , which would appear in this macro to be in Ws2 and correspondingly , originally we would have dynamically obtained that range something like
Ws2.Range("C1:C" & Lr2 & "")
With our dynamically obtained last row being obtained something like this
Ws2.Range("B" & Ws2.Rows.Count).End(xlUp).Row
Based on if a match is or is not found, then something is or isn’t done.
It is starting to give the impression that you have no access to, or knowledge what so ever of Excel. let alone VBA.
You often don't / won't understand something that a small mentally handicapped child could and mostly would understand.
It is clear that there is no real inteligence behind who or what is producing the questions: most of the time you have no idea at all about the questions you are pasting.
You seem to be pasting badly explained mixed up questions , and as before, posting some canned replies that you don’t seem to understand either yourself half the time.
Whatever it is you are attempting to do , it is incredibly inefficient, and mostly achieves nothing other than just wasting every bodies time.
The only amazing thing is that you are getting worse and worse. Whatever you are attempting was, up until now, wasting 10 – 100 times more time than necessary. Your post are now becoming so full of errors and so mixed up that you are wasting 1000 times more than necessary.
It is totally crazy, and getting crazier by the day… .
But some people at excelforum seem happy to play the game with you. So maybe best is to just register another dozen accounts there and continue in your games.
I am beginning to think that your main aim is to just keep as many people possible busy at a forum answering the same and similar questions over and over again… I think there is at least a small chance that you are a Bot are part of an attempt to develop a Bot to ask questions at forums..
It is clear that there is no real inteligence behind who or what is producing the questions: most of the time you have no idea at all yourself about the questions you are pasting, that is to say duplicate cross posting with multiple accounts everywhere...( https://excelfox.com/forum/showthrea...h-Introduction )
Np
i changed all these lr to : Let Lr1 = 10000: Lr2 = 10000
Simple, I was just trying to make it perfect but No Doubt it will also work & it will work 101% perfect
I asked the problem bcoz on that day u told sometime it will work or sometime it will not work thats y i asked the question but by putting this line : Let Lr1 = 5000: Lr2 = 5000
it will work perfect bcoz u have created this macro & u have putted : Let Lr1 = 5000: Lr2 = 5000 this line to the macro & and i was not satisfied with this line : Let Lr1 = 5000: Lr2 = 5000 , but now i will manage it
I have no more question to ask 99.99%, work is done Bro
Thnx Doc for helping me for providing me the macros & for putting ur Great Effort in my Research
Have a Awesome Day
Code:Sub ApplciationProgram()
Application.ScreenUpdating = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim RowCount1 As Integer
Dim ColumnCount1 As Integer
Dim RowCount2 As Integer
Dim ColumnCount2 As Integer
Dim OnemyArray() As Variant
Dim TwomyArray() As Variant
Dim RowCount As Integer
Dim sheetNumber As Integer
Dim rowNumber As Integer
Dim stateFlag As Boolean
Dim RowNumbers() As Variant
Dim Counter As Integer
stateFlag = False
While (Not stateFlag)
TwoExcellFilePath = "C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx"
sheetNumber = 4
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Sheets(3)
RowCount1 = ws1.UsedRange.Rows.Count
ColumnCount1 = ws1.UsedRange.Columns.Count
OnemyArray = ws1.Range("A1:H" & RowCount1).Value
Set wb2 = Workbooks.Open(filename:=TwoExcellFilePath)
Set ws2 = wb2.Sheets(sheetNumber)
RowCount2 = ws2.UsedRange.Rows.Count
ColumnCount2 = ws2.UsedRange.Columns.Count
RowCount = RowCount2
TwomyArray = ws2.Range("A1:K" & RowCount2).Value
wb2.Close SaveChanges:=True
Set wb2 = Nothing
Counter = 0
ReDim RowNumbers(RowCount1)
For i = 2 To RowCount1
For j = 1 To RowCount2
If (ws1.Cells(i, 5) = TwomyArray(j, 2) And ws1.Cells(i, 3) = TwomyArray(j, 4)) Then
ws1.Rows(i).EntireRow.Delete
RowCount1 = ws1.UsedRange.Rows.Count
End If
Next
Next
wb1.Save
Set wb1 = Nothing
Exit Sub
Wend
Application.ScreenUpdating = True
Exit Sub
End Sub
Function copyFiles(source As String, destination As String)
Dim fso As Object
Dim strFileExists As String
Set fso = CreateObject("scripting.filesystemobject")
strFileExists = Dir(source)
If strFileExists > "" Then
fso.movefile source:=source, destination:=destination
Else
MsgBox "File does not exists to copy"
End If
End Function
Function SplitWord(text As String) As String
Dim indexPoint As Integer
indexPoint = InStr(text, "-EQ")
SplitWord = Left(text, indexPoint - 1)
End Function
I have a macro to do the same but it is not deleting the entire row so plz see & help me out in the same
https://www.excelforum.com/excel-pro...orrection.html
Problem Solved
.
For future readers to learn ... how did you correct the issue ?