I am trying to extract a column from one workbook and trying to paste it in another workbook.
The code was working fine, I am completely lost, why I am getting this error
Object does not support this property or method
in the line
LCell = Selection.SpecialCells(xlCellTypeLastCell).Address
Could anyone help me, to figure out the reason.
Below is the complete code
Sub Extractred()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
CopyCol = Split("AK", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Selection.SpecialCells(xlCellTypeLastCell).Address
LCC = Selection.SpecialCells(xlCellTypeLastCell).Column
lcr = Selection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook
'lcr = y.Cells(y.Rows.Count, "A").End(xlUp).Row
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("B4")
Application.CutCopyMode = False
x.Close
End Sub
Alternatively, you can use the RangeSelection property of the Window object, which will refer to the selected cells on the worksheet even if a graphic object is selected...
LCell = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
You can get this type of error if a non-Range is Selected at the time the macro is run.
Make sure a Range is Selected, and not some Shape, Chart, etc.
Related
I am trying to get the data from the other Excel workbook into Userform. So when selected from the Dropdown list the user get automatcally fill the textboxes.
Below is the Code I tried but showing error. Please help me to resolve this issue.
Private Sub cmbls_DropButtonClick()
Dim i As Long, LastRow As Long
Dim w As Workbook
Set w = Workbooks.Open("C:\Users\Desktop\Inputs for Gate 1.xlsx")
Set ssheet = w.Worksheets("Sheet1")
'showing error in the below line LastRow'
LastRow = Sheets(“Sheet1”).Range(“A” & Rows.Count).End(xlUp).Row
If Me.cmbls.ListCount = 0 Then
For i = 2 To LastRow
Me.cmbls.AddItem Sheets(“Sheet1”).Cells(i, “A”).Value
Next i
End If
End Sub
Private Sub cmbls_Change()
Dim i As Long, LastRow As Long
Dim w As Workbook
Set w = Workbooks.Open("C:\Users\Inputs for Gate 1.xlsx")
Set ssheet = w.Worksheets("Sheet1")
LastRow = Sheets(“Sheet1”).Range(“A” & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets(“Sheet1”).Cells(i, “A”).Value = (Me.cmbls) Or _
Sheets(“Sheet1”).Cells(i, “A”).Value = Val(Me.cmbls) Then
Me.TextBox1 = Sheets(“Sheet1”).Cells(i, “B”).Value
End If
Next
End Sub
The error is due to Smart Quotes wrapping your sheet and range references.
Remove all Smart Quotes with CTRL + F & Find and Replace All swapping (“) & (”) for the correct quote notation, (").
Note the subtle difference betwen the 3 quotes used below. VBA requires the 3rd
“ <> ” <> "
Here are some other updates. You did not declare your worksheet reference and need to qualify all of your objects. This compiles now, but may still produce Run Time Errors or may have Logic Errors present.
Option Explicit
Private Sub cmbls_DropButtonClick()
Dim WB As Workbook: Set WB = Workbooks.Open("C:\Users\Desktop\Inputs for Gate 1.xlsx")
Dim WS As Worksheet: Set WS = WB.Worksheets("Sheet1")
Dim i As Long
If Me.cmbls.ListCount = 0 Then
For i = 2 To WS.Range("A" & WS.Rows.Count).End(xlUp).Row
Me.cmbls.AddItem Sheets("Sheet1").Cells(i, "A").Value
Next i
End If
End Sub
Private Sub cmbls_Change()
Dim WB As Workbook: Set WB = Workbooks.Open("C:\Users\Inputs for Gate 1.xlsx")
Dim WS As Worksheet: Set WS = WB.Worksheets("Sheet1")
Dim i As Long
For i = 2 To WS.Range("A" & WS.Rows.Count).End(xlUp).Row
If WS.Cells(i, "A").Value = (Me.cmbls) Or WS.Cells(i, "A").Value = Val(Me.cmbls) Then
Me.TextBox1 = WS.Cells(i, "B").Value
End If
Next i
End Sub
I am trying to copy data from one workbook to another.
my source workbook, contains data with 722 rows. but the code is copying only 72 rows.
While I was debugging, in siiurcewkbk, I could see 722 rows being selected but then in destwkb its just 72 rows being pasted.
also, the column in my sourcewb is in AK and I want them to be pasted in column A of destwb.
Could anyone help me to rectify this issue.
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
CopyCol = Split("AK", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
LCC = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
lcr = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub
anylead would be helpful.
If you are just coping one column of data from one worksheet to another column in another worksheet there is a lot easier way of doing it.
Does the code below help? Sorry if I've misunderstood your requirements ...
Sub Extract()
Dim Path2 As String '** path to the workbook you want to copy to ***
Dim X As Workbook '*** WorkBook to copy from ****
Dim Y As Workbook '** WorkBook to copy to
Set X = ActiveWorkbook '** This workbook ****
Path2 = "C:\test" '** path of book to copy to
Set Y = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
X.Sheets("From").Range("A:A").Copy Destination:=Y.Sheets("ALL").Range("A1")
Application.CutCopyMode = False
Y.Save
Y.Close
End Sub
Try this, I commented out some lines that were doing nothing as far as I can see because I'm strict about code. Also I added some Dim statements because I always write code with Option Explicit at the top of module, this is there to help the programmer as it traps hidden compile errors.
The solution to your problem is in the lines
Dim rngLastCell As Excel.Range
Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)
so what we're doing here is go to the last line of the sheet on row 65535 (I know later versions have more rows but this number is fine) and then we say End(xlUp) which logically means go up this column until you find some text which will be the bottom row of your block of data.
Just underneath I changed the syntax of the Range statement which is very flexible so one call Range with a string like Range("A1:B3") or one can call Range with two arguments each of them cells, so Range(Range("A1"),Range("B3")).
Option Explicit
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
Dim CopyCol
CopyCol = Split("AK", ",")
'* LR is never used
'LR = Cells(Rows.Count, 1).End(xlUp).Row
'* lc is never used
'lc = Cells(1, Columns.Count).End(xlToLeft).Column
'* LCell is never used
'LCell = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
'* LCC is never used
'LCC = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
Dim lcr
lcr = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
Dim Count As Long
For Count = 0 To UBound(CopyCol)
Dim rngLastCell As Excel.Range
Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)
Dim temp As Excel.Range
'Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
Set temp = Range(CopyCol(Count) & "1", rngLastCell)
If Count = 0 Then
Dim CopyRange As Excel.Range
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub
CopyCol = Split("AK", ",") is Array("AK")... why?
For Count = 0 To UBound(CopyCol) ... Next runs from 0 to 0 (one cycle).
to put it in an shorter sub, I recommend something like this:
Sub Extract()
Dim path1 As String
path1 = ThisWorkbook.Path & "\Downloads"
Dim CopyCol As String
CopyCol = "AK"
With Workbooks.Open(filename:=path1 & "\Red.xlsx")
With .ActiveSheet
.Range(.Cells(1, CopyCol), .Cells(.Rows.Count, CopyCol).End(xlUp)).Copy ThisWorkbook.Sheets("All").Range("A4")
End With
.Close
End With
End Sub
I have an excel file in drive "D".I would like to copy the data from workbook
"raw" from sheet1 to the another workbook "SC" in sheet "BW".
I am using the below code, to extract the data from one workbook and pasting it to another.
Sub extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
CopyCol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Selection.SpecialCells(xlCellTypeLastCell).Address
LCC = Selection.SpecialCells(xlCellTypeLastCell).Column
LCR = Selection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Student\Jenny\Raw.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & LCR)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("BW").Range("A5").PasteSpecial
x.Close
End Sub
This code is workin, but the problem is , in my sheet "sheet1" I have my data starting from A4, and would like to copy the data in destination sheet "BW" from A5.
The current code, paste the copied data from A7. How can I modify such a way that it pastes the copied data from A5.
Any lead would be helpful.
In Set temp try 4 instead of 1 as
Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & LCR)
How I can select an particular sheet (Sheet Result) from source sheet. ?
Use
With x.Sheets("Result")
.
.
.
End With
or
x.Sheets("Result"). or whatever you are trying.
You have many unused and undeclared variables. Your updated code may look something like this:
Option Explicit
Sub extract()
Dim x As Workbook, y As Workbook
Dim temp As Range, CopyRange As Range
Dim LR As Long, LC As Long, LCR As Long, Count As Long
Dim copycol
copycol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Student\Jenny\Raw.xlsx")
With x.Sheets("Result")
LCR = .Cells(.Rows.Count, 1).End(xlUp).Row
For Count = 0 To UBound(copycol)
Set temp = .Range(copycol(Count) & "4:" & copycol(Count) & LCR)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("BW").Range("A5").PasteSpecial
End With
x.Close
End Sub
I am creating a VBA application that will find the text that I have entered in a certain range (Should be dynamic, in order for me to input more in the future). With that the entered texts in the range will look for the words in another sheet column:
Example:
And it will look for the words inputted in another sheet.
Dim Main as Worksheet
Set Main = Sheets("Sheet1")
Dim Raw2 as Worksheet
Set Raw2 = Sheets("Sheet2")
LookFor = Main.Range(D8:100)
Fruits = Raw2.Range("G" & Raw2.Rows.Count).End(xlUp).row
For e = lastRow To 2 Step -1
value = Raw2.Cells(e, 7).value
If Instr(value, LookFor) = 0 _
Then
Raw2.Rows(e).Delete
Honestly I am not sure how to proceed. And the mentioned code is just experiment. Desired output is to delete anything in sheet2 except for the rows that contain the words that I have inputted in the "Look for the words". Hope you can help me. Thank you.
This should do the trick :
Sub Sevpoint()
Dim Main As Worksheet
Set Main = Sheets("Sheet1")
Dim Raw2 As Worksheet
Set Raw2 = Sheets("Sheet2")
Dim LooKFoR() As Variant
Dim LastRow As Double
Dim i As Double
Dim j As Double
Dim ValRow As String
Dim DelRow As Boolean
LooKFoR = Main.Range(Main.Range("G8"), Main.Range("G" & Main.Rows.Count).End(xlUp)).Value
LastRow = Raw2.Range("G" & Raw2.Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
ValRow = Raw2.Cells(i, 7).Value
DelRow = True
'MsgBox UBound(LooKFoR, 1)
For j = LBound(LooKFoR, 1) To UBound(LooKFoR, 1)
If LCase(ValRow)<>LCase(LooKFoR(j, 1)) Then
Else
DelRow = False
Exit For
End If
Next j
If DelRow Then Raw2.Rows(i).Delete
Next i
End Sub
I'm having trouble with the code below.
I'm trying to use the values from column "A" in wb2 to search in column "G" in wb1.
Column "A" in wb2 contains a long list of numbers and I'm trying to search a exact match of that number in column "G" in wb1.
When there's a match I need it to set the value of column "AF" at the correct row in wb2 to the corresponding match from wb1, but from another column, maybe column "Z" instead of "G".
The to workbooks are already open, when running the macro.
Hope you can help me out.
Thanks in advance.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")
LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb1.Sheets("Period").Range(wb1.Sheets("Period").Range("G1"), wb1.Sheets("Period").Range("G1").End(xlDown)).Rows.Count
LastRowWb2 = wb2.Sheets("Oversigt").Range(wb2.Sheets("Oversigt").Range("A1"), wb2.Sheets("Oversigt").Range("A1").End(xlDown)).Rows.Count
For y = 7 To LastRowWb1
For x = 1 To LastRowWb2
If wb1.Sheets("Period").Range("G" & y).Value = wb2.Sheets("Oversigt").Range("A" & x).Value Then
wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & y)
End If
Next x
Next y
End Sub
Here's how I would look to carry out your requirement (assuming I understood it clearly enough anyway!). This code loops through all rows in column A in wb2, and performs a Find operation against column G in wb1. Where it's found, it sets AF column in wb2 for that row to be the value from wb1's Z column on the same row.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set wb1sht = wb1.Worksheets("Period")
Set wb2sht = wb2.Worksheets("oversigt")
LastRowWb1 = wb1sht.Cells(wb1sht.Rows.Count, "G").End(xlUp).Row
LastRowWb2 = wb2sht.Cells(wb2sht.Rows.Count, "A").End(xlUp).Row
For y = 1 To LastRowWb2
findMe = wb2sht.Range("A" & y).Value
With wb1sht.Range("G7:G" & LastRowWb1)
Set oFound = .Find(findMe)
If Not oFound Is Nothing Then
' Found number - set AF in wb2 on this row to Z on the same row from wb1
wb2sht.Range("AF" & oFound.Row).Value = wb1sht.Range("Z" & oFound.Row).Value
Else
' Didn't find number, so do whatever you might need to do to handle this in here...
End If
End With
Next
End Sub
This should fix your issue ( I've not wrote this in VBA so there might be the odd syntax issue).
Essentially, you can 'Find' your value in wb1 and if its there paste that value into wb2.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Dim fndRange as Range
Dim wb1Value as variant
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")
LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb2.Sheets("Period").Range("G" & Rows.Count).End(xlUp).Row
LastRowWb2 = wb2.Sheets("Oversigt").Range("A" & Rows.Count).End(xlUp).Row
For y = 7 To LastRowWb1
wb1Value = wb1.Sheets("Period").Range("G" & y).Value
Set fndRange = wb2.Sheets("Oversigt").Range("A1:A" & LastRowWb2).Find(What:= wb1Value)
If Not fndRange is Nothing Then
wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & fndRange.Row)
End If
Next y
End Sub
Sub ROAC()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Target_Data As Range
Dim y As Integer
'Since you were using same sheets over and over, I just set ws1 and ws2
'instead of writing Wb1.Sheets("Period") wb2.Sheets("Oversigt") everytime
Set ws1 = Workbooks("EP_BB_DK_ny.xlsm").SHEETS("Period")
Set ws2 = Workbooks("Laaneoversigt.xlsm").SHEETS("Oversigt")
lastrow = ws2.Cells(ws2.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = ws1.Range(ws1.Range("G1"), ws1.Range("G1").End(xlDown)).Rows.Count
For y = 7 To LastRowWb1
''''This compares ws1.Range("G" & y) with ws2.Column A and set Target_Data as matching range
Set Target_Data = ws2.Columns("A").Find(ws1.Range("G" & y).Value)
''''This check if the Target_data found data or not (Find method will return Nothing if it doesn't find it.)
If Not (Target_Data Is Nothing) Then
''''''''This will write ws1. Column Z's data to ws2. Column AF on same row as where the data is found
ws2.Range("AF" & Target_Data.Row) = ws1.Range("Z" & y)
End If
Next y
End Sub
I might be little off on getting source data and target data.
It's really confusing
Anyway, You can play around with it to make it work :)