Complete beginner for VBA so simpler the better.
I want to collect all sheet names in excel and insert them to the first row. I'm able to collect the names with macro that I found (bellow) but I don't know how to convert the values to be in the first row only and not in the first column?
Sub TestNames()
Dim Ws As Worksheet
Dim LR As Long
For Each Ws In ActiveWorkbook.Worksheets
LR = Worksheets("Worksheet Names").Cells(Rows.Count, 1).End(xlUp).Row + 1
'This LR varaible to find the last used row
Cells(LR, 1).Select
ActiveCell.Value = Ws.Name
Next Ws
End Sub
https://www.wallstreetmojo.com/vba-name-worksheet/#:~:text=In%20VBA%2C%20to%20name%20a,its%20name%20using%20Worksheet%20object.
Worksheet Names to First Row
Option Explicit
Sub TestNames()
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Worksheet Names")
Dim sws As Worksheet
Dim c As Long
For Each sws In ThisWorkbook.Worksheets
c = c + 1
dws.Cells(1, c).Value = sws.Name
Next sws
End Sub
Very close, just check for last column, and re-arrange Cells(LR, 1).Select
like in example below.
Keep in mind, finding last row and last column is not very straight forward task, there are different methods, - investigate them and apply the one which fits the best.
Sub TestNames()
Dim Ws As Worksheet
Dim LastColumn As Long
For Each Ws In ActiveWorkbook.Worksheets
'LR = Worksheets("Worksheet Names").Cells(Rows.Count, 1).End(xlUp).Row + 1
LastColumn = Worksheets("Worksheet Names").Cells(1, Worksheets("Worksheet Names").Columns.Count).End(xlToLeft).Column + 1
Worksheets("Worksheet Names").Cells(1, LastColumn).Value = Ws.Name
Next Ws
End Sub
Related
I'm trying to loop through each worksheet in my workbook and change the text in column G to upper case, with the header column remaining unchanged.
Sub capitalize_columns()
Dim wb as ThisWorkbook
Dim ws as Worksheet
set wb = ThisWorkbook
For Each ws in wb.worksheets
With ws
Dim last_row as Long
last row = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim capital_range As Range
Set capital_range = ws.Range("G2:G" & last_row)
capital_range.Value = capital_range.Parent.Evaluate("Index(UPPER(" & name_range.Address & "),)")
End With
Next ws
End Sub
The script runs but I it doesn't produce my desired result of capitalizing the everything in column G with the exception of the header.
I think you are overcomplicating the upper case part. All you need is UCase() in a loop like shown here:
Sub capitalize_columns()
Dim ws As Worksheet
Dim row As Long
Dim last_row As Long
For Each ws In ThisWorkbook.Worksheets
With ws
last_row = .Cells(.Rows.Count, 1).End(xlUp).Row ' use column A to find last row
For row = 2 To last_row ' start at row 2
.Range("G" & row) = UCase(.Range("G" & row))
Next
End With
Next ws
End Sub
Your code is good! Index(UPPER()) is a faster way as it doesn't loop as mentioned in Convert an entire range to uppercase without looping through all the cells. Your code just needs few fixes.
Fixes:
Declare the objects on the top and not in the loop.
Find the last row of column G and not A. You may not get the true range if the column data is uneven.
Use Option Explicit. It will catch typos like last_row Vs last row and also name_range
Code:
Option Explicit
Sub capitalize_columns()
Dim wb As ThisWorkbook
Dim ws As Worksheet
Dim last_row As Long
Dim capital_range As Range
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
With ws
'~~> Find last row in col G
last_row = .Cells(.Rows.Count, 7).End(xlUp).Row
Set capital_range = .Range("G2:G" & last_row)
capital_range.Value = .Evaluate("Index(UPPER(" & capital_range.Address & "),)")
End With
Next ws
End Sub
I have user running a macro that formats specific worksheets within a workbook. After running this macro, the user has trailing zeros that generate in multiple worksheets and they are looking for a way to remove those zeros from each worksheet.
Initially, I provided them with the vba below but this is only useful for a single worksheet.
I was curious if there was an easy way to alter the VBA below to accommodate multiple worksheets, or would I need to rewrite the VBA altogether.
I have provided an image that will hopefully help visualize what I mean by trailing zeros....Feel free to request additional information. Thank you ahead of time for the help!
Sub contentkiller()
Dim lastRow As Long
With ActiveSheet
'Find last row in col C
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'clear data
.Range("A" & lastRow + 1 & ":Y" & .Rows.Count).ClearContents
End With
End Sub
Trailing Zeros at the Bottom of a Dataset
You can just loop through all worksheets. Hopefully they are similar in structure. Something like this should work.
Sub runAll()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Call contentkiller(ws)
Next ws
End Sub
Private Sub contentkiller(ws As Worksheet)
Dim lastRow As Long
With ws
'Find last row in col C
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'clear data
.Range("A" & lastRow + 1 & ":Y" & .Rows.Count).ClearContents
End With
End Sub
Remove Trailing...
In each worksheet of a workbook, it will find the bottom-most non-empty cell in the first column of its used range. If the cell is located above the bottom-most cell(s) of the used range, it will clear the contents in all of the rows of the used range, that are below the found cell.
Option Explicit
Sub RemoveTrailing()
Dim wb As Workbook: Set wb = ActiveWorkbook
' If you plan to copy this code into each workbook then use:
'Set wb = ThisWorkbook
Dim ws As Worksheet
Dim crg As Range
Dim lCell As Range
Dim lRow As Long
Dim ulRow As Long
For Each ws In wb.Worksheets
With ws.UsedRange
With .Columns(1)
Set lCell = Nothing
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
End With
If Not lCell Is Nothing Then
lRow = lCell.Row
ulRow = .Row + .Rows.Count - 1
If lRow < ulRow Then
Set crg = .Rows(lRow - .Row + 2).Resize(ulRow - lRow)
crg.ClearContents
End If
'Else
' empty first column
End If
End With
Next ws
End Sub
I have 100 worksheets in a workbook. In each sheet, there are blank rows for the first rows. For some sheets, the 8th row is where the data begins. For some sheets data begins on the 9th or 10th.
My code goes to the first row that has a value and then offset one row up. Then i need it to delete.
My code works on a single sheet just fine, but when i try to iterate through all the worksheets in the workbook, it doesn't go beyond the active worksheet.
What can i do to iterate through the worksheets?
Sub To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each Ws In wb.Worksheets
Set rng = Range("A1", Range("A1").End(xlDown).Offset(-1, 0))
For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
Rows(iCntr).EntireRow.Delete
Next
Next Ws
End Sub
Added Ws. in front of your range so it knows to change with the sheet.
Sub To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each Ws In wb.Worksheets
Set rng = Ws.Range("A1", Ws.Range("A1").End(xlDown).Offset(-1, 0))
For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
Ws.Rows(iCntr).EntireRow.Delete
Next
Next Ws
End Sub
Try a different approach, delete the first row over and over gain, until the content of A1 is not blank:
Do Until Ws.Range("A1").Value <> vbNullString
Ws.Rows(1).Delete
Loop
Would like to create a Macro to loop through all of the sheets in the workbook and select all the data from each worksheet and then paste said data into a single consolidate table on the "Master" sheet. All sheets have the same column heading to Column "AB".
Currently tried using this code but I have been unable to get anything to paste over onto the Master worksheet. Might be overthinking setting the range each tab.
Just looking for a simple solution to copy all active data from each sheet and paste it into one sheet so that is its all consolidated.
Thanks in advance!
Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim WB As Workbook
Dim rngDst As Range
Dim rngSrc As Range
Dim DstLastRow As Long
Dim SrcLastRow As Long
'Refrences
Set wkstDst = ActiveWorkbook.Worksheets("Master")
'Setting Destination Range
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)
'Loop through all sheets exclude Master
For Each wkstSrc In ThisWorkbook.Worksheets
If wkstSrc.Name <> "Master" Then
SrcLastRow = LastOccupiedRowNum(wkstSrc)
With wkstSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLastRow, 28))
rngSrc.Copy Destination:=rngDst
End With
DstLastRow = LastOccupiedRowNum(wkstDst)
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)
End If
Next wkstSrc
End Sub
Throwing another method into the mix. This does assume that the data you are copying has as many rows in column A as it does in any other column. It doesn't require your function.
Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim rngSrc As Range
Set wkstDst = ThisWorkbook.Worksheets("Master")
For Each wkstSrc In ThisWorkbook.Worksheets
If wkstSrc.Name <> "Master" Then
With wkstSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 28)
rngSrc.Copy Destination:=wkstDst.Cells(Rows.Count, 1).End(xlUp)(2)
End With
End If
Next wkstSrc
End Sub
You have copied this from somewhere else and you have forgotten to copy the function that gets the last row of a worksheet, namely this one LastOccupiedRowNum
So add this function to the same module and the code should work. Please don't forget to mark this as the right answer if it did work:
Function LastOccupiedRowNum(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
'Finds the last row in a particular column which has a value in it
If sh Is Nothing Then
Set sh = ActiveSheet
End If
LastOccupiedRowNum= sh.Cells(sh.Rows.Count, colNumber).End(xlUp).row
End Function
Try finding the last row dynamically, rather than using .cells
Dim lrSrc as Long, lrDst as Long, i as Long
For i = 1 to Sheets.Count
If Not Sheets(i).Name = "Destination" Then
lrSrc = Sheets(i).Cells( Sheets(i).Rows.Count,"A").End(xlUp).Row
lrDst = Sheets("Destination").Cells( Sheets("Destination").Rows.Count, "A").End(xlUp).Row
With Sheets(i)
.Range(.Cells(2,"A"), .Cells(lrSrc,"AB")).Copy Sheets("Destination").Range(Sheets("Destination").Cells(lrDst+1,"A"),Sheets("Destination").Cells(lrDst+1+lrSrc,"AB"))
End With
End If
Next i
This should replace your sub and the related function.
I am trying to copy rows from Sheet1 which meet a crieteria and post the whole row at the end of the current data. I am able to copy the row but it is not pasting it. Help will be appreciated. Here is my code I have written:
Sub Button1_Click()
Dim i As Integer
'Range("H2:O65536").ClearContents
Sheets("Sheet1").Select
LastRowColA = Range("A65536").End(xlUp).Row
For i = 2 To LastRowColA
If Cells(i, 6) = "No" Then
Rows(i).Select
Rows(i).Copy
Sheets("Sheet2").Select
Dim LastRow As Long
Dim StartRow As Long
Dim Col As Long
Dim Row As Long
StartRow = 2
Col = 1
LastRow = findLastRow(1)
For Row = StartRow To LastRow
Rows(LastRow).Select
ActiveSheet.Paste
Next Row
Else
'do nothing
End If
Next i
End Sub
Function findLastRow(ByVal Col As Integer) As Long
'Find the last row with data in a given column
findLastRow = Cells(Rows.Count, Col).End(xlUp).Row
End Function
here we go: a tad shorter, but should do the job...
Sub Button1_Click()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
For i = 2 To ws1.Range("A65536").End(xlUp).Row
If ws1.Cells(i, 6) = "No" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 6).End(xlUp).Row + 1)
Next i
End Sub
To add a bit more help, why spend all that (processing) time looping through a potentially large row set when you can just filter and copy all your data at once?
See code below. You may need to tweak it a bit to match your data set.
Sub Button1_Click()
Dim ws1 as Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 as Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
With ws1
.UsedRange.AutoFilter 6, "No"
'-> assumes data starts in column A, if not adjust the 6
Intersect(.UsedRange,.UsedRange(Offset(1)).SpecialCells(xlCellTypeVisible).Copy
' -> assumes No's are there, if they may not exist, will need to error trap.
End With
With ws2
.Rows(.Cells(ws2.Rows.Count, 6).End(xlUp).Row + 1).PasteSpecial xlPasteValues
End With
ws1.AutoFilterMode = False
End Sub
// Just use it.
Sheet2.Select (Sheet1.Rows(index).Copy)
Sheet2.Paste (Rows(index))
If you want to copy, paste two or more rows then use the for loop.