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
Related
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 am trying to check whether Row 1 of my active sheet named "Exceptions" contains the text "Control Date" (two spaces) or "Control Date".
My code finds the condition false.
Dim a As Range
Dim exceptions As Worksheet
Set exceptions = ActiveWorkbook.Worksheets("Exceptions")
For Each c In Exceptions.Range("A1:Z1")
If c = "Control Date" Then
Cells.Find(What:="control date", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Else
Cells.Find(What:="Control Date", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
Next c
Example of a worksheet with two spaces in "Control Date"
How to write the condition
As far as checking if the cell value is "Control Date" with a single space or one with two spaces, there are two ways of going about it:
Use the like operator
The like operator makes it easy to compare a string to a basic pattern. In this example, using the wildcard character * (Zero or more characters) will return true regardless of how many spaces are between Control and Date.
If cell.Value2 Like "Control*Date" Then
' Do something with that cell
End If
Use the or operator
Using the or operator ok to use as well, although not a flexible and perhaps a bit more difficult to see what's going on for your specific example.
If cell.Value2 = "Control Date" Or cell.Value2 = "Control Date" Then
' Do something with that cell
End If
Worksheet Codename
Each worksheet has whats called a codename. This is a reference that can be called directly in the code to that specific worksheet by it's name.
To set this name, in the properties window update the name property
So instead of
Dim Exceptions As Worksheet
Set Exceptions = ActiveWorkbook.Worksheets("Exceptions")
For Each cell In Exceptions.Range("A1:Z1")
' Do something...
Next cell
you can call the worksheet reference directly
For Each cell In Exceptions.Range("A1:Z1")
' Do something...
Next cell
Putting it together
Instead of using c for your variable, I like to make my variables easier to read and follow so I used cell.
Also, instead of hard coding your header columns in range, you could loop the cells of the entire first row. This is option suggestion though.
Lastly, be more explicit in what property you are looking for in your Cell. In my example I use .value2 to show I am looking for the value of that cell.
Public Sub Demo()
Dim cell As Range
For Each cell In Exceptions.Rows(1).Cells
If cell.Value2 Like "Control*Date" Then
' Do something with that cell
End If
Next cell
End Sub
Why duplicate the data into a third column? Whenever you need the "combined" date, just go get it, but do not store it twice.
Option Explicit '<<-- always have this
Sub doFindControl()
Dim a As Range
Dim c As Range '<<-- add this
Dim colDate As Long, colNumber As Long, colBlank As Long '<<--add this
Dim exceptions As Worksheet
Set exceptions = ActiveWorkbook.Worksheets("Exceptions")
For Each c In exceptions.Range("A1:Z1")
' first find the 2 key columns
If InStr(c, "Control") > 0 Then
If InStr(c, "Date") > 0 Then
colDate = c.Column
ElseIf InStr(c, "Number") > 0 Then
colNumber = c.Column
End If
' second look for the first blank column for you to put results in
ElseIf c.Text = "" Then
colBlank = c.Column
Exit For ' stop looking after its found
End If
Next c
' now you have the 2 FROM columns, and the TO column
MsgBox (colDate & " " & colNumber & " " & colBlank)
' and you can loop thru all the rest of the rows doing combine
End Sub
Thank you for all the answers! Robert Todar's answer led me to my lightbulb moment, and I can't believe at how simple the answer was. All I had to do was change this code:
Cells.Find(What:="Control Date", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
to:
Cells.Find(What:="Control*Date", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
I have a table in Sheet1. I need to search in Sheet1 for terms in Sheet2-ColumnA.
The exclusion list in Sheet2-ColumnA does not match the cell contents in Sheet1, but is found within the cell contents (Ex: find "orange" in "yellow;orange" or "orange;yellow").
If that criteria is found, delete the row. If it doesn't find the criteria, continue on down the list until it reaches an empty cell.
I recorded one round of this, but I need to modify it to loop through the entire exclusion list until it reaches an empty cell in the exclusion list.
Sub ExclusionList()
'
' ExclusionList Macro
' Find terms from exclusion list and delete row
'
' Go to sheet2 and select first term in exclusion list
Sheets("Sheet2").Select
Range("A1").Select
' Copy cell contents and find in sheet 1
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Cells.Find(What:="orange", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
' Delete row if found
Application.CutCopyMode = False
Selection.EntireRow.Delete
End Sub
In this example, "orange" is the criteria in Sheet2 A1. If it is possible to skip the copy/paste and refer directly to the exclusion list in the Cells.Find() function it seems like that would clean up the code and be more efficient overall.
Try this.
Here is a useful resource on avoiding Select/Activate. This shortens code considerably and makes it more effective.
Sub ExclusionList()
Dim r As Range, rFind As Range
With Sheets("Sheet2")
For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 'loop through every cell in sheet2 column A
Set rFind = Sheets("Sheet1").Cells.Find(What:=r.Value, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then 'check that value is found to avoid error on next line
rFind.EntireRow.Delete
End If
Next r
End With
End Sub
I have a workbook with 200+ Excel spreadsheets with the same structure. On these sheets the value for Theme is always in cell C2 and the value for Date is always in C7, but when it comes to Root_cause and Solutions they start from different rows.
I need to copy this information on the main sheet and append it:
Maybe it's a good idea to use the find function to find the word 'Root_cause', then choose one column to the right and drag down to copy all related rows?
Code:
Sub Protocol()
Dim wsheet As Worksheet
With ThisWorkbook.Sheets("Main")
For Each wsheet In ThisWorkbook.Sheets
If wsheet.Name <> "Main" Then
Set Date = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
Set Theme = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
Set Root_cause = .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
Set Solutions = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
Date.Value = wsheet.Range("C7").Value
Theme.Value = wsheet.Range("C2").Value
#Then I need to use FIND function on each sheet, come to word 'Root_cause', choose all rows for Root_cause and Solutions, copy them and append on sheet "Main"
End If
Debug.Print wsheet.Name
Next wsheet
End With
End Sub
Here is a solution to use the find function and limit to the cells right below the "rootcause" label.
Sub SelectActualUsedRange()
Dim FirstCell As Range, LastCell As Range
Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
Set FirstCell = Cells(Cells.Find(What:="root_cause", After:=LastCell, SearchOrder:=xlRows, _
SearchDirection:=xlNext, LookIn:=xlValues).Row, _
Cells.Find(What:="root_cause", After:=LastCell, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, LookIn:=xlValues).Column)
Range(FirstCell.Offset(1, 0), LastCell.Offset(0, -5)).Copy
End Sub
note I created two sheets one with the "rootcause" starting at row 13 and another starting at row 25. The rest is simply selecting the main sheet and pasting the "rootcause" values onto that sheet.
here is the image of the two separate sheets.
EDIT: notice that I'm only selecting the two columns in the middle from where "rootcause" is found all the way down to the last nonempty cell.
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