I have two comboboxes set in sheet1. I need to add the list of sheets to combobox one, which works fine. I need to add the first column of sheet2 to combobox two with the first cell as the name (called "Name"). This code worked for my UserForm, with Me instead of Sheet1, but using either doesn't work for me.
I'm getting an "Object doesnt support this property or method" error.
Thanks,
Private Sub Workbook_Open()
Dim refSheet As Worksheet
Set refSheet = ActiveWorkbook.Sheets(2)
Dim oSheet As Excel.Worksheet
For Each oSheet In ActiveWorkbook.Sheets
Sheet1.ComboBox1.AddItem oSheet.Name
Next oSheet
Dim lastrow As Long
lastrow = refSheet.Cells(Rows.Count, 1).End(xlUp).Row
With refSheet.Columns(1)
Range(Cells(1, 1), Cells(lastrow, 1)).Select
Selection.CreateNames Top:=True
End With
Sheet1.ComboBox2.RowSource = "Name"
End Sub
Refer to the sheet:
lastrow = refSheet.Cells(Rows.Count, 1).End(xlUp).Row
should be:
lastrow = refSheet.Cells(refSheet.Rows.Count, 1).End(xlUp).Row
When you use "With" here:
With refSheet.Columns(1)
Range(Cells(1, 1), Cells(lastrow, 1)).Select
Selection.CreateNames Top:=True
End With
you should actually use it with the dots:
With refSheet.Columns(1)
.Range(.Cells(1, 1), .Cells(lastrow, 1)).Select
Selection.CreateNames Top:=True
End With
(Notice the dots prior to range and cells)
Not using dots in the "With" block refers to the ActiveSheet
Related
I've been trying to copy and paste a range of filtered cells in a specific space in my excel sheet (take a look in the images) using vba , but when I try to do that, the
error 1004
occurs. I've searched in a lot of forums and try to solve my problem in different ways but it isn't working and the error 1004 still occurs.
Sub arrumando_dados_pro_xml()
Dim n As Integer
Dim i As Integer
Dim m As Integer
Dim j As Integer
n = Cells(1000, 1).End(xlUp).Row
j = Cells(n - 1, 1).End(xlUp).Row
m = Cells(1, 50).End(xlLeft).Row
Range(Worksheets("Planilha1").Cells(2, 1), Worksheets("Planilha1").Cells(j, m)).SpecialCells(xlCellTypeVisible).Copy
'''Range("A2:P37").SpecialCells(xlCellTypeVisible).Select
''''Selection.SpecialCells(xlCellTypeVisible).Select
'''Selection.SpecialCells(xlCellTypeVisible).Copy
''''Call Plan1.AutoFilter.Range.Copy
Range(Worksheets("Planilha2").Cells(1, 1), Worksheets("Planilha2").Cells(1, m)).Paste
Range(Worksheets("Planilha2").Cells(1, 1), Worksheets("Planilha2").Cells(1, m)).Copy
Range(Worksheets("Planilha1").Cells(n, 1), Worksheets("Planilha2").Cells(n, m)).Copy
''' Range(Cells(n, 1), Cells(n, m)).Select
''' ActiveSheet.Paste
End Sub
Since your code was a little confusing, I simplified it. Here is a basic code example, with comments, to copy visible cells in a range and paste. It can be modified as needed.
'Declare your variables
Dim ws1 As Worksheet, ws2 As Worksheet, As Range, lRow As Long, lCol As Long
'Assign your variables, you should always identify the workbook and worksheet
'ThisWorkbook refers to the workbook where your code resides
Set ws1 = ThisWorkbook.Sheets("Planilha1")
Set ws2 = ThisWorkbook.Sheets("Planilha2")
'Using your worksheet variable find the last used row and last used column
lRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
lCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
'Define your range by resizing using lRow and lCol.
Set rng = ws1.Cells(2, 1).Resize(lRow - 1, lCol)
'Copy the visible cells in the range(normally used after filtering or with hidden rows/columns)
rng.SpecialCells(xlCellTypeVisible).Copy
'paste the copied range starting on row 1, after the last column with data, by using .Offset(, 1)
ws2.Cells(1, 1).PasteSpecial xlPasteValues
If you have any questions, please ask and I will help.
Edited I modified your code, had to make changes, see comments
'Added worksheet variables
Dim ws1 As Worksheet, ws2 As Worksheet, n As Long, m As Long 'removed j As Long
Set ws1 = ThisWorkbook.Sheets("Planilha1")
Set ws2 = ThisWorkbook.Sheets("Planilha2")
n = ws1.Cells(1000, 1).End(xlUp).Row
'Removed [j = ws1.Cells(n - 1, 1).End(xlUp).Row] if there are no blank cells after "n" the new last used row then j = 1
m = ws1.Cells(1, 50).End(xlToLeft).Column 'you can't use .End(xlLeft).Row to get the last column
'changed j to n, if j = 1 then only the top two rows will be copied
ws1.Range(ws1.Cells(2, 1), ws1.Cells(n, m)).SpecialCells(xlCellTypeVisible).Copy
'when pasting, just use one cell
ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False 'Exits the CutCopyMode, removes "Marching Ants"
I recently split my code into two sections to stop the date automatically being entered, as on a Monday, we need to do 3 days worth of data
All I did was Add a new sub and redefine the variables - now i can't delete a named range
My code:
Option Explicit
Sub Import()
Dim ws As Worksheet, lastRowC As Long
Set ws = Worksheets("Report")
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row + 1 ' bottom populated cell of Column "C", plus 1
With ws.QueryTables.Add(Connection:= _
"TEXT;N:\Operations\001 Daily Management\Cemex\FMSQRY.CSV", Destination:= _
ws.Cells(lastRowC, 3))
.Name = "FMSQRY"
' etc
' etc
.Refresh BackgroundQuery:=False
End With
With ActiveWorkbook
.Connections("FMSQRY").Delete
.Names("FMSQRY").Delete
End With
End Sub
Sub TodaysDate()
Dim ws As Worksheet, lastRowC As Long, lastRowH As Long
Set ws = Worksheets("Report")
lastRowH = ws.Cells(ws.Rows.Count, 8).End(xlUp).Row + 1 ' bottom populated cell of Column "H", plus 1
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row ' bottom populated cell of Column "C"
With ws.Range(ws.Cells(lastRowH, 8), ws.Cells(lastRowC, 8))
.FormulaR1C1 = "=TODAY()"
.Value = .Value
End With
End Sub
So nothing to do with the Named Range was actually touched
.Name = "FMSQRY" still names my range, but when .Names("FMSQRY").Delete comes around I get a 1004 Error
ANSWER:
With ActiveWorkbook
.Connections("FMSQRY").Delete
With ws
.Names("FMSQRY").Delete
End With
End With
Your Name is on sheet-level and not Workbook-level.(you could have the same name on different sheets)
so:
ActiveWorkbook.Worksheets("Report").Names("FMSQRY").Delete
I am not sure why that code doesn't work.
But if you write code like below then it works...
Dim nm As Name
For Each nm In ActiveWorkbook.Names
If nm.Name = "FMSQRY" Then nm.Delete
Next nm
Try the below code without the .connections:
Option Explicit
Sub test()
With ThisWorkbook
.Names("FMSQRY").Delete
End With
End Sub
I would like to move down one row all the cells from a column (in my case column C). It means if I have “X” written in cell C1, it should move down to Cell C2, if I have “Y” written in cell C1000,it should move down to Cell C1001…
I have the following error message:
Run time error 1004, application defined or object defined error
Sub movedownrowcolumnC()
Range("C:C").Offset(1).Select
End Sub
try below macro.
Sub MoveDowncolumn()
Dim lastRow As Integer
With Worksheets("Sheet1")
lstrow = .Cells(Rows.Count, "C").End(xlUp).Row
For i = lstrow To 1 Step -1
.Cells(i + 1, "C").Value = .Cells(i, "C").Value
Next i
End With
End Sub
use:
Cells(Rows.Count, "C").End(xlUp).Offset(1).Select
although you most probably don't need to Select anything and just go with the Range variable:
Sub movedownrowcolumnC()
Dim myRange As Range
Set myRange = Cells(Rows.Count, "C").End(xlUp).Offset(1)
myRange.Value = "myValue"
End Sub
While much more than just "good coding practice" is to always explicitly qualify a Range object up to its Worksheet reference:
Sub movedownrowcolumnC()
Dim myRange As Range
With Worksheets("mySheetName") ' reference wanted worksheet (change "mySheetName" to your actual relevantsheet name)
Set myRange = .Cells(.Rows.Count, "C").End(xlUp).Offset(1) ' ser referenced worksheet column C cells right below last not empty one
End With
myRange.Value = "myValue"
End Sub
Did you ask for this?
Range("C1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
You can you:
Option Explicit
Sub Test()
With ThisWorkbook.Worksheets("Sheet1")
If .Range("C1").Value = "Test" Then
.Rows(.Range("C1").Row + 1).Select
End If
End With
End Sub
Please can you help with the below; I have an increasing list of staff listed in A1, and I want my formulas in E1, F1, G1, etc. to be autofilled and not static like I have now.
I have the below but its throwing up the error: Method 'Range' of object '_Global' failed
My vba code;
Sub AutoFill()
Dim RowCount As Variant
RowCount = Range(("A1"), Range("A1").End(xlDown)).Rows.Count
Range("E1").Select ' Default formula's in E1
Selection.AutoFill Destination:=Range(RowCount - 1), Type:=xlFillDefault
End Sub
What am I missing, i'm stumped and have been since yesterday...
Thanks in Advance.
The Range.FillDown method method may be easier to code.
Sub DynAutoFill()
Dim lastRow As long
lastRow = cells(rows.count, "A").end(xlup).row 'should -1 be added here?
Range(cells(1, "E"), cells(lastRow, "E")).filldown
End Sub
FillDown can easily handle multiple columns.
Sub DynAutoFill()
Dim lastRow As long
lastRow = cells(rows.count, "A").end(xlup).row 'should -1 be added here?
Range(cells(1, "E"), cells(lastRow, "G")).filldown
End Sub
Your own code needs the entire range as the destination.
Sub DynAutoFill()
Dim RowCount As Variant
RowCount = Range(("A1"), Range("A1").End(xlDown)).Rows.Count
Range("E1").AutoFill Destination:=Range(cells(1, "E", cells(RowCount - 1, "E")), Type:=xlFillDefault
End Sub
I wouldn't use a reserved word for the name of the sub procedure.
I have a row of dynamic column headers in the "Summary" tab and 111 worksheets appended at the end of the workbook, although this number is subject to change. I search for each column header in each appended worksheet and copy the cell immediately beneath any match to its corresponding column and row, a new row for each appended worksheet, in the "Summary" tab. The output meets my expectations. The time necessary to loop through every appended worksheet does not. Please let me know if there are obvious ways to optimize the code or more efficiently achieve my desired results. Thanks in advance.
Sub riasummary()
Dim riawksht As Worksheet
Dim consolwksht As Worksheet
Dim c As Integer
Dim r As Long
Dim sheader As Range
Dim sheaders As Range
Dim rheader As Range
Dim rheaders As Range
c = Sheets("Summary").Cells(1, Columns.Count).End(xlToLeft).Column
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
For Each riawksht In ActiveWorkbook.Worksheets
If riawksht.Name <> "Summary" Then
Set rheaders = riawksht.Range("a5:xfd12")
For Each rheader In rheaders
For Each sheader In sheaders
r = Sheets("Summary").Cells(Rows.Count, "a").End(xlUp).Row
If rheader.Value = sheader.Value Then
rheader.Offset(1, 0).Copy
sheader.Offset(r, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
'sheader.Offset(1, 0).Value = rheader.Offset(1, 0).Value
End If
Next
Next
End If
Next
End Sub
As a tangent, I also occasionally return an "Application-defined or object-defined error" at the following line of code that I cannot seem to decipher, and any insight here would be much appreciated as well.
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
Should be:
With Sheets("Summary")
Set sheaders = Sheets("Summary").Range(.Cells(1, 1), .Cells(1, c))
End With
You should always avoid unqualified Cells or Range calls, since they will default (in a regular module) to the active sheet.