what I am trying to do is fairly straight forward:
Select any range of cell in WorkBook A (with value in it)
Look up every single value in that selected range from an (two columns) array in WorkBook B (say A1:B10000)
Return the value from the 2nd column of the array to Workbook B back to WorkBook A to the columns immediately to the right next to the range selected in step 1.
Here is the code I have been working so far.
Sub Checker()
Dim rw As Long, x As Range
Dim extwbk As Workbook, twb As Workbook
Dim SelRange As Range
Set twb = ThisWorkbook
Set SelRange = Selection
Set extwbk = Workbooks.Open("path to the file in my harddrive")
Set x = extwbk.Worksheets("Sheet1").Range("A1:B100000")
With twb.ActiveSheet
For rw = Selection.Row To Selection.Rows.Count + rw - 1
.Cells(rw, Selection.Column + 1) = Application.VLookup(.Cells(rw, Selection.Column).Value2, x, 2, False)
Next rw
End With
Somewhere in the section part of the code something is wrong but I cannot really figure it out. Could any of you folks help?
Related
so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.
Unfortunately I have come to face a problem I wasn't able to solve on my own.
When defining a range I want to rearrange the columns in a different order.
For example:
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")
Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
How can I fix this? I want the order to be another one than the original one.
Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:
my_range(A2:E2) goes into A2:E2 in the new sheet
yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet
I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.
Edit:
Here's the code that puts the values from the ranges into the new sheet
Do
If Application.WorksheetFunction.CountA(my_range) > 0 Then
my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set my_range = my_range.Offset(1, 0)
Else
Exit Do
End If
Loop
Do
If Application.WorksheetFunction.CountA(yo_range) > 0 Then
yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set yo_range = yo_range.Offset(1, 0)
Else
Exit Do
End If
Loop
We can see that the Copy method will re-arrange the data left-to-right. Try this:
Option Explicit
Public Sub CheckClipboard()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim objData As Object
Dim varContents As Variant
' test data b,c,d,e,f,g in Sheet1!B1:G1
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")
Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
rngToCopy.Copy '<-- copy
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
' copy current cell formula to clipboard
objData.GetFromClipboard
varContents = objData.GetText
Debug.Print varContents '<-- re-arranged left-to-right
' cancel copy
Application.CutCopyMode = False
End Sub
I get this in the immediate window:
b c d e f g
So, using Copy is not going to work for what you want to do.
In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:
Option Explicit
Sub MixColumns()
Dim ws As Worksheet
Dim rngIn As Range
Dim rngOut As Range
Dim lng As Long
Dim rngArea As Range
Dim rngCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
' example 1
Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- works
' example 2 - OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g
' example 3 - solution for OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells
lng = 1 '<-- rngOut cell counter
' iterate areas
For Each rngArea In rngIn.Areas
' iterate cells in area
For Each rngCell In rngArea.Cells
rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
lng = lng + 1 '<-- increment rngOut counter
Next rngCell
Next rngArea '<-- results in e,f,g,b,c
End Sub
Give this output:
I have a somewhat simple macro that I have made but I am rusty as I have not coded in a few years. As simply as I can put it, I Have two different Workbooks. If the workbook I have open has a certain value (or no value), I want it to fill the other workbook("Test Template") with either "proposal or pre-proposal."
That has all been easy for me. But since the worksheet adds rows as we input data, I need it to fill those values in the next available row.
I will attach code but don't worry about the proposal stuff, I just need the range changed from a specific cell into the next available cell in the column. (if d28 is full, put in d29).
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
'copy Names from x(active):
x.Sheets("Sheet1").Range("C4").Copy
'paste to y worksheet(template):
y.Sheets("Sheet1").Range("B28").PasteSpecial
If x.Sheets("Sheet1").Range("C15") = "" Then
y.Sheets("Sheet1").Range("D28").Value = "proposal"
Else
y.Sheets("Sheet1").Range("D28").Value = "preproposal"
End If
First, you need a variable where you'll store the last used row number:
dim lngRows as long
lngRows = Cells(Rows.Count, "D").End(xlUp).Row
Then replace your lines of code where you have .Range("B28") with either .Cells(lngRows+1,2) or .Range("B"&lngRows)
The object Range offers a method called End that returns the last range on a certain direction.
Range("A1").End(xlDown) '<-- returns the last non-empty range going down from cell A1
Range("A1").End(xlUp) '<-- same, but going up
Range("A1").End(xlToRight) '<-- same, but going right
Range("A2").End(xlToLeft) '<-- same, but going left
In your case, hence, you can detect and use the last row of column B like this:
nextRow = y.Sheets("Sheet1").Range("B3").End(xlDown).Row + 1
More details:
The first Range of your column B is the header Range("B3")
You get the last filled range going down with .End(xlDown)
Specifically, you get the Row of that range
You add + 1 (cause you want the next available row
You store the row in the variable nextRow
... that you can then use like this:
y.Sheets("Sheet1").Range("B" & nextRow ).PasteSpecial
Try this
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
Dim fromWs As Worksheet
Dim toWs As Worksheet
Dim Target As Range
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
Set fromWs = x.Sheets("Sheet1")
Set toWs = y.Sheets("Sheet1")
With fromWs
Set Target = toWs.Range("b" & Rows.Count).End(xlUp)(2) '<~~next row Column B cell
Target = .Range("c4") 'Column B
If .Range("c15") = "" Then
Target.Offset(, 2) = "proposal" 'Column D
Else
Target.Offset(, 2) = "preproposal"
End If
End With
End Sub
So we have an instrument that generates a bunch of data but names the sheets effectively randomly. I have the easy commands to go copy, paste and sort the respective text on the excel sheets but my problem is I can't figure out how to make the list of sheets that I generate loop through all those sheets while not specifying the name in the beginning..I don't want it to loop through all sheets because I need it to overlook the first sheet...
I'm getting an error 424 Object Req'd error. Any help would be greatly appreciated.
So I set all of my integers and variables
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer
Dim compoundname As Range
Dim compoundtype As Range
Dim compoundrng As Range
x = 1
y = 3
a = 3
b = 2
y,a,b are all associated with my settings omitted from the last part.
So here I tell it that I want compound name to be the range only on the active sheet, which I think is my actual problem?
Set compoundname = Workbook.ActiveSheet.Range("A3")
Set compoundrng = Sheets("AllSheets").Range("A3:A100")
And after I've added all the sheets to the workbook, I have the loop for the names that store on the "AllSheets" worksheet
For Each ws In Worksheets
Sheets("AllSheets").Cells(x, 1) = ws.Name
x = x + 1
Next ws
Then we have to tell it to access that list:
For Each compoundtype In compoundrng.Cells
copy, paste and sort my info here
Next compoundtype
Why don't you do something like
For Each ws In Worksheets
if(ws.Name <> 'YourFirstSheetName') Then
'copy, paste and sort info here.
end if
Next ws
Edit: Updated for your comment.
If you don't care about cell formatting then don't use the copy/paste command. Just set the cell equal to the value of the other cell. That way you don't have to play around with clipboard or active sheets/cells, etc.
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer
Set ws = Worksheets("Quant Sheet")
y = 3
Worksheets("Quant Sheet").Activate
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "Quant Sheet") Then
Sheets("Quant Sheet").Cells(y, 1) = ws.Range("A3")
y = y + 1
End If
Next ws
I have a range of data on Sheet2 that links it to Sheet1 (Sheet1 is formatted and linked by Sheet2 using =if(Sheet2$x$x="","",Sheet2$x$x); this way any data put into the range C13:G62 of Sheet2 shows up in Sheet1 range C13:G62. The beginning portion on the code works to move JUST the data in the specified range to the BATCH file Sheet3 and finds the last row pasting the values from Sheet1 without copying the formulas. It was made this way so I can delete data on Sheet2 to wipe Sheet1 clean but still have all the backup data on one Sheet3.
Anyway, the problem lies when I tried to manipulate the code to copy all contents on Sheet1 (to DUPLICATE SHEET1) to another sheet at the end of the workbook:
Sheets(Sheet1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
This allowed me to name the sheet which was great. However by creating multiple variations of code it will not move the DATA in the RANGE to the newly created Sheet4 (there is no data). In one iteration of code I was able to get Sheet1 to copy and make Sheet4 at the end of the work book with no data in the range but have the cursor land in cell C13, the starting point for pasting just the values, and when I left click the mouse in that cell to "paste values" it would paste the values that I was trying to paste. However, either way I rearranged the code, the data would always be copied but would never paste to the Sheet4 range.
Here I have posted one variation of the code IN WHICH IT STILL WILL NOT PASTE THE VALUES TO SHEET4 (THE NEWLY CREATED SHEET) but still copies to the BATCH FILE. What am I missing here?
Dim s1Sheet As Worksheet
Dim s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Invoice"
target = "TOTAL_INVOICE"
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Sheets(source)
Set s2Sheet = Sheets(target)
Set rngSource = s1Sheet.Range("C13:G62")
Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
'Set rngTargetFinish = ws1.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'rngTargetFinish.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'Set target = Sheets("Sheet4").Range("B13:G63")
copy_non_formulas source:=rngSource, target:=rngTargetStart
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B70:G109") Unhighlight
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B13:G63") Unhighlight
'===Copies Sheet to End of WorkBook & Pastes Values======
Sheets(source).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
Range("C13:G62").ClearContents
Dim rng As Range
Set rng = ActiveSheet.Range("C13:G62")
rng.ClearContents
Dim s3Sheet As Worksheet
Dim rngTargetStart2 As Range
Set s3Sheet = Sheets(Sheets.Count)
Set rngTargetStart2 = s3Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart2.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
copy_non_formulas2 source:=rngSource, target2:=rngTargetStart2
copy_non_formulas2 source:=Range("C13:G62"), target2:=Range("C13:G62")
This is an Integrated Public Sub
copy_non_formulas(source As Range, target As Range)
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
And another Public Sub for the Second Move
copy_non_formulas2(source As Range, target2 As Range)
Dim x As Long
Dim y As Long
Dim d As Range
For x = 1 To source.Rows.Count
For y = 1 To source.Columns.Count
Set d = source(RowIndex:=x, ColumnIndex:=y)
If Left(d.Formula, 1) <> "=" Then
target2(RowIndex:=x, ColumnIndex:=y).Value = d.Value
End If
Next y
Next x
I am attempting to first, find the the largest value in a column (C), then copy and paste that value into the next empty cell in 'Row 3' in a different (master) workbook. The macro I am running is found in the master workbook. I found this code that i believe will get the pasted cell into the correct spot, but I could use assistance in the code for how to find the largest cell in column C in the data workbook, and then copying and pasting that value.
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextColumn As Long, LastRow As Long
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextColumn = wsMaster.Range("C", 3).End(xlUp).Column + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
wbDATA.Close False
End Sub
Try this. First sort the column you need the value from, then get the last row and place the value into your first empty column in row 3 of your master sheet.
' Create an excel application and open the workbook containing the data
Dim app As Object
Dim wb As Object
Dim ws As Object
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("C:\Workbook1")
Set ws = wb.Sheets(1)
' Get last row with a value to use for the sort range
Dim last As Long
Dim value As Long
With ws
last = ws.Cells(ws.Rows.Count, 3).End(xlUp).row
.Range("C1:C" & last).Sort Key1:=.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom
value = .Cells(last, 3)
End With
' Get the last filled cell and move over one to get the empty column
Dim col As Long
col = ActiveSheet.Cells(3, 1).End(xlToRight).Offset(0, 1).Column
ActiveSheet.Cells(3, col).value = value
wb.Close False
Set ws = Nothing
Set wb = Nothing
Set app = Nothing