search ,copy and paste entire row
I have 2 workbooks- first workbook is my main workbook that in that book i have company names with sorted truely with alotof dataes in another cloumns- in second book i have company name not sorted-
i wanna write a macro that: have a loop that finds workbooks(1) first company name in workbook(2) sheet(1) and copes all its entire raws to workbook(2) shetts(2) and then second company name and etc until 1000.
can anyone help me develope below codes?
Sub sorting() Dim companyname As String Dim counter As Integer For counter = 1 To 1000 companyname = Workbooks(1).Worksheets(1).Cells(counter, 1) //in workbooks(2).worksheets(1).in cloumn A search companyname //if there wasnt companyname next counter //if else copy entire raw contain companyname //paste that in workbooks(2).Worksheets(2).row(counter) //next counter End Sub
See also questions close to this topic
How to read excel in python from user input
I have an excel file that looks like this:
Bob | 15
Joe | 25
Tim | 19
I'm trying to write a code so that if the user inputs the name bob, it will print 15.. or if the user inputs Joe, it will print 25 etc
I can't figure out how to get python to read an input string and match it to the cell in excel
Database (Excel) Access Speed - Using Open XML SDK in Visual Studio C# (DOM Approach)
I mostly write number-crunching programs using Visual Studio C# (2019) where I am simply taking input data, calculating results and displaying it. No complicated Network or Internet programming. Think first or second college level programming coarse from the early 1990's.
For inputs I was reading in data from an excel file using the following directive:
using Excel = Microsoft.Office.Interop.Excel;
This proved to be very slow when executing the program. I then learned this way of accessing an Excel file is no longer supported and has been superseded by Open XML SDK. Please see the following link to the Microsoft Dev Center page:
For what I want to do the Document Object Model(DOM) approach seems most appropriate for the thousands of individual excel cells I want to read as input data. However, the Microsoft Dev Center is certainly not the most user-friendly resource and the code example provided for reading an Excel file using this DOM approach is writing to a console which I'm not using. I never did get my code to work.
Long and short of it is, I got my code working using the GetCellValue Method:
However, this 'GetCellValue' method is still taking way too long. I need to read in thousands or tens of thousands of Excel input data cells in seconds or fractions of seconds not 20 seconds to a minute.
I think if I had an example of the DOM method reading in Excel data to an Array Variable (instead of writing to the console) it would help. Can anyone provide an example of such code?
Excel VBA Google Places API (Nearby Search) not returning results
I am calling this VBA function from Excel which uses the Google Places API Nearby Search function and is not returning results. I know there are results since this HTTP call returns results for the same input parameters. Do you know why the function is not returning results?
https://maps.googleapis.com/maps/api/place/nearbysearch/json?location=45.5662453,-122.6628821& radius=1500&type=park&key= AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ
Public Function GetNearbyPark(latitude As Double, longitude As Double, Radius As Integer) As String
'----------------------------------------------------------------------------------------------------- 'This function returns the park name for a given latitude and longitude and radius using the Google 'Places Nearby Search API. 'Radius is in meters '-----------------------------------------------------------------------------------------------------
'Declaring the necessary variables. Dim apiKey As String Dim xmlhttpRequest As Object Dim xmlDoc As Object Dim xmlStatusNode As Object Dim xmlNearbyParkNameNode As Object Dim xmlNearbyParkAddressNode As Object 'Set your API key in this variable. 'Here is the ONLY place in the code where you have to put your API key. apiKey = "AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ" 'Check that an API key has been provided. If apiKey = vbNullString Or apiKey = "The API Key" Then GetNearbyPark = "Empty or invalid API Key" Exit Function End If 'Generic error handling. On Error GoTo errorHandler 'Create the request object and check if it was created successfully. Set xmlhttpRequest = CreateObject("MSXML2.ServerXMLHTTP") If xmlhttpRequest Is Nothing Then GetNearbyPark = "Cannot create the request object" Exit Function End If 'Create the request based on Google Places API. Parameters (from Google page): '- Longitude '- Latitude '- Radius 'xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _ '& "&address=" & Application.EncodeURL(address) & "&key=" & apiKey, False Debug.Print "At API call" xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & "location=" & "latitude" & "," & longitude & "&radius=" & Radius & "&type=park&key=" & apiKey, False 'Send the request to the Google server. xmlhttpRequest.send 'Create the DOM document object and check if it was created successfully. Set xmlDoc = CreateObject("MSXML2.DOMDocument") If xmlDoc Is Nothing Then GetNearbyPark = "Cannot create the DOM document object" Exit Function End If 'Read the XML results from the request. xmlDoc.LoadXML xmlhttpRequest.responseText 'Get the value from the status node. Set xmlStatusNode = xmlDoc.SelectSingleNode("//status") Debug.Print xmlStatusNode 'Based on the status node result, proceed accordingly. Select Case UCase(xmlStatusNode.Text) Case "OK" 'The API request was successful. 'At least one result was returned. 'Get the park name and address node values of the first result. Set xmlNearbyParkNameNode = xmlDoc.SelectSingleNode("//result/name") 'Set xmlNearbyParkAddressNode = xmlDoc.SelectSingleNode("//result/vicinity") Debug.Print xmlNearbyParkNameNode 'Return the park name and address as text 'GetNearbyPark = xmlNearbyParkNameNode.Text & ", " & xmlNearbyParkAddressNode.Text GetNearbyPark = xmlNearbyParkNameNode.Text Case "ZERO_RESULTS" 'The geocode was successful but returned no results. GetNearbyPark = "No park exists within the radius of the defined coordinates" Case "OVER_DAILY_LIMIT" 'Indicates any of the following: '- The API key is missing or invalid. '- Billing has not been enabled on your account. '- A self-imposed usage cap has been exceeded. '- The provided method of payment is no longer valid ' (for example, a credit card has expired). GetNearbyPark = "Billing or payment problem" Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the quota limit. GetNearbyPark = "Quota limit exceeded" Case "REQUEST_DENIED" 'The API did not complete the request. GetNearbyPark = "Server denied the request" Case "INVALID_REQUEST" 'The API request is empty or is malformed. GetNearbyPark = "Request was empty or malformed" Case "UNKNOWN_ERROR" 'The request could not be processed due to a server error. GetNearbyPark = "Unknown error" Case Else 'Just in case... GetNearbyPark = "Error" End Select 'Release the objects before exiting (or in case of error). errorHandler: Set xmlStatusNode = Nothing Set xmlNearbyParkNameNode = Nothing Set xmlNearbyParkAddressNode = Nothing Set xmlDoc = Nothing Set xmlhttpRequest = Nothing End Function
Intersection Error with Multiple VBA Loops
I'm trying to write a code to move rows into separate sheets based on input, I have it working for one case as shown below:
Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range If Intersect(Target, me.Range("AN:AN")) Is Nothing Then Exit Sub For Each C In Intersect(Target, me.Range("AN:AN")).Cells If C.Text "Y" Then C.EntireRow.Copy Worksheets("Closed").Cells(Rows.Couint, "AN").End(xlUp).Offset(1).EntireRow C.EntireRow.Delete End If Next End Sub
Now I want to have a seperate case for a seperate column reference but when I try and repeat the code into the same subroutine I get an error '1004 intersect error', I have tried quite a few things but the error seems to always be thrown with the second intersect statement:
Private Sub Worksheet_Change(ByVal Target As Range) Dim C, B As Range If Intersect(Target, me.Range("AN:AN")) Is Nothing Then Exit Sub For Each C In Intersect(Target, me.Range("AN:AN")).Cells If C.Text "Y" Then C.EntireRow.Copy Worksheets("Closed").Cells(Rows.Count, "AN").End(xlUp).Offset(1).EntireRow C.EntireRow.Delete End If Next If Intersect(Target, me.Range("D:D")) Is Nothing Then Exit Sub For Each B In Intersect(Target, me.Range("D:D")).Cells If B.Text "Q" Then B.EntireRow.Copy Worksheets("Quoted").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow B.EntireRow.Delete End If Next End Sub
I tried to group the two presence checks into one statement at the start but it still threw an error during the second loop, as shown:
If Intersect(Target, me.Range("AN:AN, D:D")) Is Nothing Then Exit Sub
How to replace "S" in a formula to be able to have a variable instead of this letter S?
I think the question is simple, the answer maybe not.
Sheet1.Cells().Value = "=SUM(E" & i & ":S" & i & ")/" & n
In short, I would like to replace the letter S with a variable (from E to AB, I don't stop to Z!) to be able to put this simple formula in a serie of cells. When writing this question, I was thinking of using an array. I think I will have a look in this direction. But, if you have a more simple answer, do not hesitate. Thank you.