Hi I have a spreadsheet which I want to use the current cells value to open the url specified there and enter into the column next to it. The URL only contains one set of characters. I tried recording with relative references turned on and got the following:
Sub GETASINV2()
'
' GETASINV2 Macro
'
'
Selection.Copy
Application.CutCopyMode = False
Workbooks.OpenText Filename:="http://upctoasin.com/027616716927", Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Selection.Copy
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Range("A1").Select
End Sub
As you can see it all seems to be relative apart from the filename where it has picked up the value I entered and not the fact that I "copy pasted the value".
Once this is done I want to repeat for the remaining list of urls (around 3000). I can probably find someway of repeating till no more URLS exist but if you know a way would be glad to get help on this part also!
Thank you
I put the link you gave us in rows A1:A10 and ran the following code to get loop through each cell and place the value from the link in the cell to it's right.
I also tested it with 1000 links and it completed in 279 seconds -- so roughly 4 per second. I'd be interested to see if anyone has a quicker method.
Sub GETASINV2()
Application.ScreenUpdating = False
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet1") 'update for your worksheet name
Dim inputRange As Range, r As Range
Set inputRange = sht.Range("A1:A10") 'update for your range
For Each r In inputRange
With sht.QueryTables.Add(Connection:= _
"URL;" & r.Value, Destination:=r.Offset(0, 1))
.Refresh BackgroundQuery:=False
.Delete
End With
Next r
Application.ScreenUpdating = True
End Sub
Update
Is there a way of it working out the size of the range itself based on the number of records without a gap?
Yes, you can replace this:
Set inputRange = sht.Range("A1:A10")
With the following:
Set inputRange = Range(sht.Range("A1"), sht.Range("A1").End(xlDown))
Where A1 is the location of your first link
Related
I have already written a code in VBA that can copy over all the necessary information of multiple sheets into one exel sheet. My problem is that one column contains numbers that have decimals (0,24 for example) which get seperated when put into an exel sheet. I have attached the code and just need a pice of it that can exchange all commas for dots so the columns stay as a whole. After that I will just reformat it by hand which isnt an issue with the amount of data I need to process
Thanks in advance
The code:
Sub Mehrere_Dateien_auswaehlen()
Dim arrDateien As Variant
Dim wbQuelle As Workbook
Dim LetzteZeile As Long
Dim cntDatei As Long
Dim rngQuelle As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arrDateien = Application.GetOpenFilename(filefilter:="Exel-Dateien (*.cs*),*.cs*", MultiSelect:=True)
If IsArray(arrDateien) Then
For cntDatei = 1 To UBound(arrDateien)
LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set wbQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))
Set rngQuelle = wbQuelle.Worksheets(1).Range("B2").CurrentRegion
Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy
ThisWorkbook.Worksheets(1).Range("A" & LetzteZeile + 1).PasteSpecial
wbQuelle.Close Savechanges:=False
Next cntDatei
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Erfolgreich zusammengeführt"
MyVar = Empty
End Sub
It's happening because the last used Text-to-columns (or Default) settings are set to split-on-comma. If you run a delimited Text-to-columns on a single non-empty cell, with no options selected (either manually, or via a script) you effectively clear out that setting and it won't split your values.
Assuming you'll want to do this with a script: the following lines, that you'll need to run before pasting anywhere - will 'clear out' the setting:
With Range("A1")
.TextToColumns Destination:=.Offset(0, 0), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
End With
Note - this uses A1 but doesn't actually alter it at all. As long as it's a non-empty cell on the active sheet it will work.
I would like to delimit my time text to the separate columns:
I used the following approach:
VBA code for "Text to Column - Fixed Width" - loop
But I don't know how to apply it for the column range down to the last row.
My code looks like this:
Dim wks As Worksheet
Dim lRow As Long
Set wks = ThisWorkbook.ActiveSheet
lRow = wks.Range("D" & wks.Rows.Count).End(xlUp).Row
With wks
.Cells(4, lRow).TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Semicolon:=True, Space:=False
.Range("S1").CurrentRegion.Columns.AutoFit
End With
And I am getting an error:
No data was selected to parse.
How can I make it work with my range of cells?
When performing text-to-column in VBA, you do not need to set the last row for the range. Just set it until end of the row will do. Please perform a test with the following by replacing cells with column only:
With wks
.Columns("D:D").TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Semicolon:=True, Space:=False
.Range("S1").CurrentRegion.Columns.AutoFit
End With
Or:
wks.range("D4:D").TextToColumns ....
This is probably a really easy thing that I am screwing up. I am working on a school project Creating an Inventory sheet.
My "Inventory" sheet has a bunch of product info on it.
My "Add Inventory" Sheet is set up with a VLOOKUP so when I scan my bar code it displays the row of information from the "Inventory sheet"
I made a macro button and recorded a Macro to try to edit the available inventory by clicking the button.
This is what I recorded.(the original I slaughtered trying to edit it but this should be the same)
Sub Macro7()
'
' Macro7 Macro
'
'
Sheets("Add Inventory").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Inventory").Select
Cells.Find(What:="764666143326", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("K15").Select
Sheets("Add Inventory").Select
Range("K13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Inventory").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L15").Select
End Sub
So my problem is the macro records the What:="764666143326" for the search with the bar code I was using for a sample. I need it to use the new bar code I scan on the next run. So I need it as a variable or to refence a cell. So I believe I need to set a Dim and a Range but have tried many times and watched a ton of videos with no success. I normally only use the record Macro button and don't not edit the VBA code. Please Help Me!!
EDIT:
Everying on this sheet is filled with VLOOKUP or a formula, except the yellow Cell B5, I scan the bar code into that cell.
Add Inventory sheet
This is the page I want to edit with the Macro/VBA. I want it to search column C for the Bar code number I scanned into the "Add Inventory" sheet (which will change depending on what I am adding) and when it finds the matching bar code I want it to edit the "Quantity in Stock" or column K for that row of the matching bar code.
Inventoy sheet
My problem is the macro I recorded saves what ever barcode I used for it not the cell as a variable.
Edit # 2
I think this show closer to what I am trying to do
Sub Macro7()
'
' Macro7 Macro
'
'
Sheets("Add Inventory").Select
Range("K13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Inventory").Select
Cells.Find(What:=Range("A1"), After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate.Offset(0, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Add Inventory").Select
Range("B5").Select
End Sub
For this one I made Inventory cell A1 = ='Add Inventory'!B5
Also My bar codes are 12 digits.
Update Inventory
Option Explicit
Sub addNewQuantity()
' Write lookup value (Bar Code) to a variable.
Dim lValue As Long: lValue = Range("B5").Value
' Define range (to look for Bar Code).
With ThisWorkbook.Worksheets("Inventory")
Dim fCell As Range: Set fCell = .Range("C4")
Dim lCell As Range: lCell = .Range(.Rows.Count, fCell.Column).End(xlUp)
Dim rg As Range: Set rg = .Range(fCell, lCell)
End With
' Attempt to find the index (row) of a match.
Dim cIndex As Variant: cIndex = Application.Match(lValue, rg, 0)
If IsNumeric(cIndex) Then
' Write new value to column 'K' (8 cells to the right from column 'C').
rg.Cells(cIndex).Offset(, 8).Value = Range("K13").Value
MsgBox "Bar Code ID '" & lValue & "' updated.", vbInformation, "Success"
Else
MsgBox "Bar Code ID '" & lValue & "' not found.", vbCritical, "Failure"
End If
End Sub
Unfortunately I think there is a bigger problem with this method recorded by the macro recorder - this code will always select range "K15" regardless of what you search for.
I recommend you do not use the macro recorder, among other reasons it often creates code full of semantic errors - i.e. it works and it does does exactly what you tell it to do, which may not be the same as what you want it to do! As in the example above.
I would try something like this (you will need to check that the worksheets, ranges and column numbers in the code below are correct for your project):
First we declare and assign a worksheet object, referring to your Inventory worksheet:
dim ws as worksheet
set ws = Sheets("Inventory")
Then we need to loop through every row on this worksheet and if the value in the barcode column matches a given search parameter, increase the value in the stock level column on that row, by the value of another cell on another sheet.
For this we will need a counter for the loop:
dim counter as integer
the search parameter:
dim searchParam as variant
searchParam = Sheets("Add Inventory").Range("B5").value
and the new value we want added to the current stock level:
dim newValue as variant
newValue = Sheets("Add Inventory").Range("K13").value
we need to tell Excel which column number to search in and which to change, I assumed you are adding stock to the inventory. You will need to change the column numbers below to suit your project
Dim barcodeColumnNumber As integer
Dim stockColumnNumber As integer
barcodeColumnNumber = 1
stockColumnNumber = 2
Now we add the loop
For counter = 1 To ws.UsedRange.Rows.Count
if ws.Cells(counter, barcodeColumnNumber) = searchParam then
ws.Cells(counter, stockColumnNumber) = ws.Cells(counter, stockColumnNumber) + newValue
End If
Next counter
I've seen several other questions similar to mine and I've tried several different solutions but I am still getting strange results. My code finds a value in another workbook in Column AA, then I want to copy that row from Column C to Column BC and paste in current workbook. All of the code works except copying from column C to BC. For some reason it starts copying the row from column AC. I've tried a standard range but I think it's relative from the active cell and I don't know if there is a way to do negative column letters so then I tried Offset and I tried .Cells but none select the correct range. Here is a couple of examples of the code I've tried:
Private Sub ComboBox1_Change()
Dim checknum As String
Dim chkrow As String
Dim Rng As Range
prfile1 = Worksheets("setup").Range("B10").Value
prfile2 = Worksheets("setup").Range("B7").Value
filepath = Worksheets("setup").Range("e10").Value
checknum = ComboBox1.Value
'Workbooks.Open filepath & prfile2
Windows(prfile2).Activate
Worksheets("MRegister").Select
With Worksheets("MRegister").Range("AA:AA")
Set Rng = .Find(What:=checknum, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Rng.Select
.Range(.Cells(ActiveCell.Row, -24), .Cells(ActiveCell.Row, 28)).Select
Selection.Copy
End With
Windows(prfile1).Activate
Sheets("ReprintOld").Range("M203:BM203").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows(prfile2).Activate
Sheets("MRegister").Range("A1").Select
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Sheets("ReprintOld").Range("A1").Select
End Sub
for Offset:
.Range(ActiveCell.Offset(0, -24), ActiveCell.Offset(0, 28)).Select
for standard Range:
.Range("C" & ActiveCell.Row & ":BC" & ActiveCell.Row).Select
You would think all of these would work, but they all start the selection several columns to the right of the active cell.
The issue is, as has been mentioned by user3561813, the fact that you have a Range object on the end of your With statement. Perhaps the simplest solution would be to use:
Intersect(Rng.Entirerow, .Worksheet.Range("C:BC")).Copy
The issue is this line: .Range(.Cells(ActiveCell.Row, -24), .Cells(ActiveCell.Row, 28)).Select
Because the With statement references With Worksheets("MRegister").Range("AA:AA"), it's trying to find the .Range property of the Column "AA".
If you rewrite it to something like Worksheets("MRegister").Range(.Cells(ActiveCell.Row, -24), .Cells(ActiveCell.Row, 28)).Select, it should work.
How about something like this after the .Find:
Rng.offset(0,3-rng.column).resize(1,53).copy
Rng is a reference to the cell with the desired checknum, offset that zero rows and back to column C, then resize it to 1 row by 53 columns (C to BC) and copy it.
You should check that the find worked before the copy:
If not rng is nothing then
You don’t need the select
here's the code I currently have in VBA (Excel) at the moment. Most of it has come from macro recordings that I've made. What I'm looking for is to be able to insert for example, row 10 as just 10 in the inputbox without having to put it in as 10:10. Is there a way for me to edit my current code to allow this? I've tried using Rows("TargetRow:TargetRow") but that gives odd results.
Dim TargetRow As Variant
TargetRow = InputBox("Insert row # where data should be inserted. This should take the format XX:XX (e.g. 90:90 for row 90)", "All Industries Row", "XX:XX")
wbThis = ThisWorkbook.Name
Windows(wbThis).Activate
Rows(TargetRow).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove
Windows("otherworksheet.xlsx").Activate
Range("A119:J119").Select
Application.CutCopyMode = False
Selection.Copy
Windows(wbThis).Activate
Range(TargetRow).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Use following sub to select rows using inputbox
Sub SelectRow()
Dim lnRow As Long
lnRow = InputBox("Enter Row number.", "Row Input")
Rows(lnRow & ":" & lnRow).Select
End Sub
If you need a Range from user input, the simplest way is to use the Excel version Application.InputBox with a type of '8' (see the documentation here).
Dim TargetRow As Range
Set TargetRow = Application.InputBox("Select the row where data should be inserted.", _
"All Industries Row", , , , , , 8)
Debug.Print TargetRow.Address
Note that you should probably also get rid of the Select and Activate calls and use your object references directly.