Hi I am creating a program which copys data from the source workbook and pastes it to another. However, in the way I have currently programed it, the active workbook/worksheet is changing as I am pasting data into the following sheet.
Below is an example of how I have set the source workbook and how I am calling it.
Property Get wsSrc() As Worksheet
Set wsSrc = ActiveWorkbook.Sheets("MBI DSCR")
End Property
Property Get wSrc() As Workbook
Set wSrc = ActiveWorkbook
End Property
The source book is called by...
Property Get col2() As Long
col2 = wSrc.Sheets("Inputs").Columns.Find(What:="Deal Team", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
End Property
Property Get wsDest() As Worksheet
Set wsDest = Workbooks("destBook.xlsm").Worksheets("Sheet1")
End Property
Then the code is called in the following example
Sub PasteCI()
Dim c As Range, cDest As Range
Set c = wsSrc.Columns(col).Find(What:="Commercial Income", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
Set cDest = wsDest.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) 'next paste destination. C2?
If c Is Nothing Then 'didn't make a match with Find() ?
cDest.Resize(6, 1).Value = "-" 'fill placeholders
Else
c.Offset(0, 1).Resize(1, 6).Copy 'got match - copy range
cDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End If
End Sub
Is there a way to keep the source sheet constant, ie when the active workbook is set all callings to wSrc is to the initial active workbook?
Related
I want to search a specified column for a String value. Then I want to grab the six values to the right of that column value. I am currently doing it like this which is working correctly.
Set c = wsSrc.Columns(col).Find(What:="DSCR Analysis", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
Note here are the declarations for the following variables.
Property Get wsSrc() As Worksheet
Set wsSrc = ActiveWorkbook.Sheets("MBI DSCR")
End Property
Property Get wSrc() As Workbook
Set wSrc = ActiveWorkbook
End Property
Property Get col() As Long
col = wsSrc.Columns.Find(What:="MBI", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
End Property
Property Get col2() As Long
col2 = wSrc.Sheets("Inputs").Columns.Find(What:="Deal Team", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
End Property
Property Get wsDest() As Worksheet
Set wsDest = Workbooks("LBM_DSCT_DataLake.xlsm").Worksheets("Sheet1")
End Property
Currently I am copying a specified value from the source sheet then pasting it to the destination sheet over and over for all the different values I want to copy.
However I am wondering if it is possible to copy all the different values (ie "DSCR Analysis") to a clipboard and then paste. So the program does not "jump" back and forth between sheets rather grabs all the data it needs once, copies it, then pastes it in the destination sheet.
Below is an example of how one of my functions works wit hthe copying and pasting. I have around 20 of these where the program jumps back and forth.
Sub PasteCI()
Dim c As Range, cDest As Range
Set c = wsSrc.Columns(col).Find(What:="Commercial Income", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
Set cDest = wsDest.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) 'next paste destination. C2?
If c Is Nothing Then 'didn't make a match with Find() ?
cDest.Resize(6, 1).Value = "-" 'fill placeholders
Else
c.Offset(0, 1).Resize(1, 6).Copy 'got match - copy range
cDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End If
End Sub
I want to go into a sheet and look for a value. If the value is there I want to grab the data in its row and paste transposed in another sheet. This function is working.
However, if the value in the column is not there I want to paste filler text into the column where the data would otherwise go.
I am getting a "Type Mismatch" error when I run the following code. What is going wrong/ how can I made this happen.
Dim c As Long
Windows("WBGrab").Activate '-> opens doc we want to look a
c = Sheets("SheetName").Columns(2).Find(What:="Commercial Income", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
If c Is Nothing Then
Windows("WBPaste").Activate
Range("C2:C7").Value = "-"
Else
Sheets("SheetName").Range("C" & c & ":H" & c).Select '-> opens MBI DSCR sheet and copes naming & values
Selection.Copy '-> copies the selected area
Windows("WBPaste").Activate '-> opens back up the data lake
Sheets("Sheet1").Range("C" & 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
End Sub
If Find() fails to make a match then your code will error before getting to If c Is Nothing Then because of the .Row tagged onto the Find() line.
Something like this should work:
Sub Tester()
Dim c As Range, wsSrc As Worksheet, wsDest As Worksheet, cDest As Range
'set up source and destination sheets
Set wsSrc = Workbooks("WBGrab").Worksheets("SheetName") 'add the file extension to the name
Set wsDest = Workbooks("WBPaste").Worksheets("Sheet1")
Set c = wsSrc.Columns(2).Find(What:="Commercial Income", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
Set cDest = wsDest.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) 'next paste destination. C2?
If c Is Nothing Then 'didn't make a match with Find() ?
cDest.Resize(1, 7).Value = "-" 'fill placeholders
Else
c.Offset(0, 1).Resize(1, 7).Copy 'got match - copy range
cDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End If
End Sub
I have a workbook that is used as a template to fill in data. The data is cleared and the workbook is reused.
The workbook has multiple worksheets and the range that needs to be cleared is different in every worksheet.
Let's say I want to clear the data in the range A10:Y50, I put value "Start" in the cell Z10, as a starting point to clear data. "Start" is located in different cell in every worksheet.
The code is clearing data based on the "Start" located in the first worksheet and not independently for each worksheet.
Sub TestReset()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> "Sheet1" And sht.Name <> "Sheet2" Then '
Dim iRow As Long, iMax As Long
iRow = Cells.Find(What:="start", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
iMax = Cells(iRow, "A").End(xlDown).Row
sht.Range("A" & iRow & ":AY" & iMax).ClearContents
End If
Next sht
End Sub
As #Tony Dallimore mentioned in his comment you need to specify in what sheet you are looking for specific cells (if you dont specify it it assumes you are looking in ActiveSheet). So it is always best to specify with what sheet you work. It is good to use With statement for that. When you use With then it is enough to use only dot "."
Sub TestReset()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
With sht
If .Name <> "Sheet1" And .Name <> "Sheet2" Then '
Dim iRow As Long, iMax As Long
iRow = .Cells.Find(What:="start", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
iMax = .Cells(iRow, "A").End(xlDown).Row
.Range("A" & iRow & ":AY" & iMax).ClearContents
End If
End with
Next sht
End Sub
Also use Dim iRow as Long before for each loop... But here is added example of how you can manage sheets to skip (Create sheet "Setup" and in cell A1 add name to skip, for example Sheet1, in cell A2 add Sheet2 and it should do the trick.
Sub WorkInUnSpecifiedSheets()
Dim xRng As Range
'sheet "Setup" must exist and Range A1 contains name of sheet to skip, current region might not work on some PCs. But it is simple
Set xRng = ThisWorkbook.Sheets("Setup").Range("A1").CurrentRegion
'you can also use another method to specify range... Named ranges for example or using last row and last column...
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets 'i would recommend using ThisWorkbook or Workbook variable instead of Active
If xRng.Find(What:=sht.Name, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) Is Nothing Then
'your code to work in unspecified sheets
End If
Next sht
End Sub
I have values in this "Sample Analysis Data" sheet in the range B2:B10.
For each cell in the range, the code looks for that value in the sheet "Meta Data". It then copies the cells in that row and pastes it in "Sample Analysis Data" (to the right of the searched value). This works for the value in B2.
I can't get it to move on to B3 and then B4 and such. It loops though and does the same thing again for B2.
What do I need to do to get it to loop to from B2 through to B10?
Along with this, how do I get it to go from B2 to the last entry in the column (as each data set I work with could have a different number of rows of data,) not just to B10?
Sub GetMetaData()
Worksheets("Sample Analysis Data").Activate
Range("B2").Select
Dim srch As Range, cell As Variant
Set srch = Range("B2:B10")
For Each cell In srch
Sheets("Meta Data").Activate
Cells.Find(What:=cell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveSheet.Cells(ActiveCell.Row, 1).Select
Range(ActiveCell, ActiveCell.End(xlToRight).End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sample Analysis Data").Activate
ActiveCell.Offset(0, 7).Select
ActiveSheet.Paste
Next cell
End Sub
Try this?
Change the i=8 to however many cells you need to offset (you indicated B2:B10, which is 8)
Sub testcopy()
Dim srch As Range, metarg As Range, rg As Range, pstrg As Range
Dim i As Long
Dim ws As Worksheet, ws2 As Worksheet
Set ws = ThisWorkbook.Sheets("Sample Analysis Data")
Set ws2 = ThisWorkbook.Sheets("Meta Data")
Set metarg = ws2.Range("A1:A100") 'range that includes the key that you are searching in B2:B10
Set srch = ws.Range("B1") 'i'm offsetting, so i'm going back one row
For i = 1 To 8 'change 8 to how many cells to offset
Set rg = metarg.Find(srch.Offset(i, 0).Value, LookIn:=xlValues, lookat:=xlWhole) 'find the value in meta sheet
If Not rg Is Nothing Then
Set pstrg = ws2.Range(rg, ws2.Cells(rg.Row, rg.End(xlToRight).Column))
pstrg.Copy
srch.Offset(i, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Next i
End Sub
I have a Excel workbook (lets call serial_numbers) that contains a list of S/N on A1 to A10 (can be more or less).
Now I have to search for A1's value on workbook "database". That value is usually found in A1 cell of workbook "database".
In case that I find A1's valueI need to copy and paste B2's value of workbook "database", which cointains the current stock of that value.
Through Developer mode on Excel I got the following result:
Sub Macro1()
'
' Check stock for S/N in database
'
'
Range("A1").Select
Selection.Copy
Workbooks.Open Filename:="database.xlsx", _
UpdateLinks:=0
Range("A1").Select
Selection.Find(What:="XXXXXX", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("serial_numbers.xlsx").Activate
Range("B1").Select
ActiveSheet.Paste
End Sub
That piece above seems to be not working properly and since Im new to this I cant get why. Can any of you help me?
If you are looking for non-vba solution then you may go for vlookup function.
Try this code :
Sub testMacro()
Dim wkbDB As Workbook
Dim rngFind As Range, rngSearch As Range, cell As Range
Dim shtDB As Worksheet
Set wkbDB = Workbooks.Open(Filename:="C:\database.xlsx", UpdateLinks:=0)
Set shtDB = wkbDB.Sheets("Sheet1")
Set rngSearch = ThisWorkbook.Sheets("Sheet1").Range("A1:A10")
For Each cell In rngSearch
Set rngFind = shtDB.Range("A1:A10").Find(What:=cell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not rngFind Is Nothing Then
'serial_numbers.xlsx
cell.Offset(0, 1) = rngFind.Offset(0, 1)
End If
Next
End Sub