I am trying to build quite a complex excel macro based on dynamic data. My first stumbling block is that i am struggling to get a button-triggered Excel macro to take name of each tab after the current one and insert its name every third column of the current sheet
I have:
Sub Macro1()
On Error Resume Next
For Each s In ActiveWorkbook.Worksheets
Sheet2.Range("A1:ZZ1").Value = s.Name
Next s
End Sub
This really does not work well, as it simply seems to enter the name of the last sheet all the way between A1 and ZZ1! what am I doing wrong?
This will put the names of worksheets in the tabs to the right of the Activesheet in every 3rd column of row 1 of the Activeshseet:
Sub Macro1()
Dim i As Long
With ThisWorkbook
'exit if Activesheet is the last tab
If .ActiveSheet.Index + 1 > .Worksheets.Count Then
Exit Sub
End If
For i = .ActiveSheet.Index + 1 To .Worksheets.Count
.ActiveSheet.Cells(1, (i - .ActiveSheet.Index) + (((i - .ActiveSheet.Index) - 1) * 2)) = .Worksheets(i).Name
Next i
End With
End Sub
Please note that it's a bad idea to useOn Error Resume Next in the general manner that you did in your original code. It can mistakenly mask other errors that you don't expect. It should just be used to catch errors that you do expect.
Related
quick question about the For Each In expression:
I use this line for all the rows in the same file, but different sheet:
For Each c In tarRng
count = count + 1
Debug.Print "c.Value: "; c.Value
Debug.Print "cAdd: "; c.Address
Debug.Print "count"; count
Next
tarRng is defined as all rows of the B column which works perfect, it cycles through all rows and outputs the value in the row and the address of each value in the debug screen. The count is there for a later function which I just left out here.
Now the question: I would like to get the B column of a different Workbook in the same folder, but when I define it like this (here fixed range since I just wanted to test it).
For Each c In Workbooks("Nvm_Configuration_ASW.xlsm").Worksheets("Tabelle2").Range("B3:B271")
It just shows the count once with the value 1 and doesn't even output c.Value or c.Address. I am sure the expression for the file and sheet are right since I tried it with the same file I am in as the filename and it worked.
Thanks,
Mathias
If the workbook is not opened, you have to open it with Workbooks.Open():
Public Sub TestMe()
Dim myCell As Range
Dim wks As Workbook
Set wks = Workbooks.Open("C:\Users\Nvm_Configuration_ASW.xlsm")
For Each myCell In wks.Worksheets(1).Range("A1:A5")
Debug.Print myCell
Next
End Sub
If it is opened, your code should be working, but it should be opened in the same Excel Instance.
By default it would be opened in the same instance, unless you do not make some additional tricks:
press Alt when openning it for Excel 2017
openning an Excel file and closing it from the small inner cross for Excel 2013 and earlier.
My problem is the macro won't work on a specified worksheet, only the active one. I have two subroutines for deleting entire columns, and then deleting entire rows if specific columns are blank. I want to make it work for a specific worksheet, which I understood to be With Worksheets("OutPut") but it still culls the active worksheet.
It works as intended so long as the active worksheet is selected.
Sub DeleteBlankColumns()
With Worksheets("OutPut")
Set MyRange = Worksheets("OutPut").UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
End With
End Sub
And
Sub QuickCull()
With Worksheets("OutPut")
On Error Resume Next
Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("C").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("D").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("E").SpecialCells(xlBlanks).EntireRow.Delete
End With
End Sub
There's a button to Call both of them, which again, will work if the worksheet I want to transform is active. For reference, this is intended to be appended on an existing company macro, so simply running it on the worksheet when it's active won't work.
Thank you!
For the first code sample,
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
should be
If Application.CountA(.Columns(iCounter).EntireColumn) = 0 Then
.Columns(iCounter).Delete
(a "." before Columns, to specify the sheet)
Same thing for the second code sample
Ok Hi everybody,
I've been looking into this and trying to figure it out for a couple days now. I've found things close but nothing matches what I need.
I have 13 departments here and each department has a sheet with issues that need to be resolved. What I need is when each of those departments updates their excel sheet with an issue it updates on the master list (which is in the same workbook). Since people are constantly deleting and adding the formula would need to stay.
Would it be easier to have them enter the data on the master sheet and have that go into the individual files? If so how would I even do that? Thanks in advance. I'm trying to see if an advance filter or something would work but can't get it just right.
You will need to adjust the names in my code but if you paste this code in each of your department sheets (not the master list) you should get your desired result:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim xlws As Excel.Worksheet
Set xlws = ActiveSheet
For i = 1 To 13
If IsEmpty(xlws.Cells(2, i).Value) = True Then
Exit Sub
End If
Next
Dim xlwsMaster As Excel.Worksheet
Set xlwsMaster = ActiveWorkbook.Worksheets("master list")
i = 1
Do While IsEmpty(xlwsMaster.Range("A" & i).Value) = False
i = i + 1
Loop
xlws.Range("A2:M2").Copy
xlwsMaster.Range("A" & i).PasteSpecial xlPasteAll
xlws.Range("A2:M2").Clear
End Sub
every time there is a change on one of those sheets it will check to see if all the values of a through m are filled if they are it copies a2:m2 and pastes it at the first empty row on the master list and then clears a2:m2 on the sheet in question
Kind of new to VBA programming but need it to complete a project.
I'm basically trying to copy and paste cells based on an IF Statement and would like to do this on a cell-by-cell basis so I incorporated a loop. The code looks like the following below. What ends up happening is that the first line is copied/pasted just fine but the loop does not continue. When I use debug.print i , the only number that is populated is 6. I've also tried a For Statement but that ends up behaving the same way. Any ideas?
Private sub Copy_Dates()
Dim i as Integer
i =6
Do
If Cells(i,79)= 1 then
Sheets("Tracking").Select
Range(Cells(i,106),Cells(i,108)).Copy
Sheets("Tr_Tracking").Select
Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues
End if
i= i+1
Loop while i < 10
End sub
EDIT:
So I've realized that the code that i wanted is not going to be very helpful to my project anymore. What I really need is a method to select non consecutive cells based on a criteria, and then copy those cells to another worksheet as a single block.
So, taking from the above code, I need to make sure to select
.range(.cells(i,106,.cells(i,108))
only when the following condition is met:
if .cells(i,79)=1
then imagine that i would have some array of selected cells based on this condition and then i would be able to paste it to the second sheet defined above wsO=thisworkbook.sheets("TR_Tracking").
I hope that makes sense and hopefully not too complicated of logic.
EDIT:EDIT:
I was able to figure this one out. I used the following code below to accomplish the edit section above.
Private Sub SelectArray_andCopy()
Dim FinalSelection as Range
Sheets("Tracking").Select
Cells(2,79).Select
For each c in intersect(activesheet.usedrange,range("CA6:CA500"))
if c.value=1 then
if finalselection is nothing then
set finalselection=range(cells(c.row,106),cells(c.row,108))
else
set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108)))
end if
end if
next c
if not finalselection is nothing then finalselection.select
Selection.copy
Sheets("TR_Tracking").Select
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues
The problem is that you are using .Select and hence the focus is changing. Also your cells objects are not fully qualified.
INTERESTING READ
Further i_25003 is incorrect. I guess you meant i + 25003
Try this (UNTESTED)
Private Sub Copy_Dates()
Dim wsI As Worksheet, wsO As Worksheet
Dim i As Long
Set wsI = ThisWorkbook.Sheets("Tracking")
Set wsO = ThisWorkbook.Sheets("Tr_Tracking")
For i = 6 To 9
With wsI
If .Cells(i, 79) = 1 Then
wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _
.Range(.Cells(i, 106), .Cells(i, 108)).Value
End If
End With
Next i
End Sub
I am trying to create an excel macro which is probably going to end up being quite large, to make things easier I am tackling it a bit at a time. So far I have....
Sub Macro4()
'
' Test Macro
'
'Selects the product_name column by header name
Dim rngAddress As Range
Set rngAddress = Range("A1:Z1").Find("product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
'Inserts new column to the left of the product_name column
Selection.Insert Shift:=xlToRight
'Re-selects the product_name column
Range(rngAddress, rngAddress.End(xlDown)).Select
'Copys the contents of the product_name column
Selection.Copy
Selection.Paste
End Sub
I want it to do the following....
Search the spreadsheet for the header name 'product_name'
Insert a blank column to the left of the 'product_name' column
Copy the contents of the 'product_name' column
Paste them into the newly created blank column
Change the header name in this new column to 'product_name_2'
Currently it works fine up until the pasting into this newly created column, then i get a
'Run-time error '438'; - Object doesn't support this property or method'
Can anyone suggest where i am going wrong?
Your error is:
Range(rngAddress, rngAddress.End(xlDown)).Select
This selects from the top of the column down to just above the first blank cell. The insert shifts this portion of the column right leaving the rest where it is. When you select again you are likely to get a larger range because you have mixed two columns. The copy fails because you are then trying to copy values over the top of values.
If that does not make sense, step through your macro with F8 and see what is happening at each step.
When you understand why your current macro does not work, try this:
Sub Macro5()
Dim rngAddress As Range
Dim ColToBeCopied As Integer
Set rngAddress = Range("A1:Z1").Find("'product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
ColToBeCopied = rngAddress.Column
Columns(ColToBeCopied).EntireColumn.Insert
Columns(ColToBeCopied + 1).Copy Destination:=Columns(ColToBeCopied)
End Sub
Note:
I did not select anything.
I have left the code operating on the active sheet but it is better to use With Sheets("XXX") ... End With.
Answer to second question
The macro recorder is not good at showing how to address individual cells systematically.
With Sheets("xxxx")
.Cells(RowNum,ColNum).Value = "product_name 1"
End With
The above uses With which I recommend. Notice the dot in front of Cells.
The one below operates on the active sheet.
Cells(RowNum,ColNum).Value = "product_name 1"
RowNum must be a number. ColNum can be a number (say 5) or a letter (say "E").
In your case RowNum is 1 and ColNum is ColToBeCopied and ColToBeCopied + 1.
P.S.
I forgot to mention that to find the botton row of a column use:
RowLast = Range(Rows.Count, ColNum).End(xlUp).Row
That is move up from the bottom not down from the top.
P.S. 2
To specify a range using Cells:
.Range(.Cells(Top,Left),.Cells(Bottom,Right))
The dots must match: all three or none.
I'm not sure where you are trying to copy to,
but when you want to paste you need to make a selection and then
ActiveSheet.Paste
For example:
/your code/
Selection.Copy
Range("O:O").Select
ActiveSheet.Paste
I would avoid copying / pasting altogether, if you only want to transfer values.
For example, instead of:
Range("B1:B100").Copy Destination:=Range("A1")
I would use:
Range("A1:A100").Value = Range("B1:B100").Value
If we were to substitute that into your code, and include some of the comments made by Tony:
Sub Macro4()
Dim colFound As Integer
Dim rowLast As Long
Const rowSearch As Integer = 1
'Find the product_name column
colFound = Rows(rowSearch).Find("product_name").Column
If colFound = 0 Then
MsgBox "The product_name column was not found."
Exit Sub
End If
'Find the last non-empty row
rowLast = Cells(Rows.Count, colFound).End(xlUp).Row
'Inserts new column to the left of the product_name column
Columns(colFound).EntireColumn.Insert
'Transfer the contents of the product_name column to the newly inserted one
Range(Cells(rowSearch, colFound), Cells(rowLast, colFound)).Value = _
Range(Cells(rowSearch, colFound + 1), Cells(rowLast, colFound + 1)).Value
'Rename the new column
Cells(rowSearch, colFound).Value = Cells(rowSearch, colFound).Value & "_2"
End Sub