I need code to select only visible cells in a specific column except the heading.
This is what I tried:
ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
But the above code will select the entire column except the heading. I need it to only select a specific column (use column D for your answers).
This will select all visible cells with data in column D, except header and last visible cell with data:
Option Explicit
Sub SelectVisibleInColD()
Dim lRow As Long
With ActiveSheet
lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
If lRow < 3 Then Exit Sub
.Cells(1, 4).Offset(1, 0).Resize(lRow - 2).SpecialCells(xlCellTypeVisible).Select
End With
End Sub
Is this what you are trying? This will select all visible cells till the last row in column A except the header:
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> I also want to exclude the last cell which is visible and contains data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row - 1
If lRow < 3 Then Exit Sub
Debug.Print Intersect( _
.Range("A2:A" & lRow), _
.Range("A1").Offset(1, 0).SpecialCells(xlCellTypeVisible) _
).Address
End With
End Sub
Related
I collated data to see my colleagues' shifts at work.
Sheet1 holds a table showing Shifts. These shift times are formulated. I am trying to copy and paste shift data as values based on today's date.
For example, if today is 31/12/2020 then copy range C3:F10 and paste as values (i.e. data preceding this date). When the date changes to the next day the range then changes from C3:F10 to C3:G10. This I am going to have continuous (a column for each day of the year)
This is what I have so far. I need some direction.
Private Sub test()
For i = c1 To h1
If Worksheets("Sheet1").Cells(i, 1).Value <= Date Then
Worksheets("Sheet1").Column(i).Copy
ActiveSheet.pastevalues
End If
Next
End Sub
Is this what you are trying? I have commented the code so you should not have a problem understanding it. But if you do then simply ask.
Code:
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim i As Long
Dim lCol As Long
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Find last column which has data in row 1
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'~~> Find last row which has data in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through the dates
For i = 3 To lCol
'~~> Check if the date is less than today's date
If .Cells(1, i).Value2 < Date Then
'~~> identify your range
If rng Is Nothing Then
'~~> Row 3 to last row
Set rng = .Range(.Cells(3, i), .Cells(lRow, i))
Else
'~~> Joining ranges
Set rng = Union(rng, .Range(.Cells(3, i), .Cells(lRow, i)))
End If
Else
Exit For
End If
Next i
'~~> Convert to values in one go
If Not rng Is Nothing Then rng.Value = rng.Value
End With
End Sub
In Action:
I created a sample file to test the above code.
I am trying to add a button, that adds a new column after the last column with values. This works.
Now I want to copy values to the new column. Values shall be copied from the last column from row 32 to the last one with a value in column A.
Right now Ihave a code for copying the whole column. How do I concentrate on the specific range?
Sub AddMeeting()
Dim ws As Worksheet
Dim lastcol As Long
Set ws = ActiveSheet
lastcol = ws.Cells(32, ws.Columns.Count).End(xlToLeft).Column
Columns(lastcol).Copy Destination:=Columns(lastcol + 1)
Range ((Cells.Columns.Count.End(xlLeft)) & Range(32)), (lastcol + 1) & Cells.Rows.Count.End(xlUp)
Application.CutCopyMode = False
End Sub
Values shall be copied from the last column from row 32 to the last one with a value in column A
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim LastColumn As String
Dim rngToCopy As Range
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Find last row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Find last column in row 32
lCol = .Cells(32, .Columns.Count).End(xlToLeft).Column
'~~> Get Column Name from column number
' https://stackoverflow.com/questions/10106465/excel-column-number-from-column-name
LastColumn = Split(Cells(, lCol).Address, "$")(1)
Set rngToCopy = .Range("A32:" & LastColumn & lRow)
Debug.Print rngToCopy.Address
With rngToCopy
'
' Do what you want here
'
End With
End With
End Sub
I've tried multiple codes without luck. I have an excel sheet with 1800 rows and the following columns: ProgramCode, StudyBoard, FacultyID and ProgramType.
In the StudyBoard column there are some cells that are empty. I will then find all the empty cells in StudyBoard and their corresponding information from the other columns. Once I've found the desired cells, they must be overwritten in a new sheet.
I have the following codes, and couldn't continue, because even what I try isn't working.
Dim ws As Worksheet
Dim StudyBoardCol As Range
Dim PromgramCodeCol As Range
Dim rndCell As Range
Dim foundId As Variant
Dim msg As String
Dim FacultyIdCol As Range
Dim ProgramTypeLetter As Range
Set ws = ThisWorkbook.Worksheets("SSBB")
Set StudyBoardCol = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set ProgramCodeCol = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
Set FacultyIdCol = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
Set ProgramTypeLetter = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
For i = 2 To 1800
Set rndCell = StudyBoardCol.Cells(Int(Rnd * StudyBoardCol.Cells.Count) + 1)
FacultyIdCol = Application.Match(rndCell.Value, ProgramCodeCol, 0)
ProgramTypeLetter = Application.Match(rndCell.Value, ProgramCodeCol, 0)
You could use SpecialCells to “isolate” blank ones
Dim cell As Range
Dim newSheet As Worksheet
Set newSheet = Sheets.Add
With ThisWorkbook.WorkSheets("SSBB") ‘reference “SSBB” sheet
For Each cell in .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks) ‘ loop through referenced sheet column A blank cells from row 2 down to last not empty one
cell.Resize(,3).Copy destination:=newSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) ‘ copy range next to current cell and paste to newSheet column A first empty cell
Next
End With
Or use Autofilter (you probably want to add a test that cells are present to be copied before attempting to set rng
Option Explicit
Public Sub TransferBlankStudyBoard()
Dim rng As Range
With ThisWorkbook.Worksheets("SSBB").UsedRange 'Or limit to columns A:D
.AutoFilter
.AutoFilter Field:=1, Criteria1:="="
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).EntireRow.Delete
.AutoFilter
End With
End Sub
I have a script that is used to find the last entry in a particular table column across different sheets and paste them into a master sheet list. It's operating as "find last used row in column B" but evidently table rows, even if they're blank, count as used rows and so most of my returns are blank because the actual value I'm looking for was entered at the top of the table instead of in the last row. It's also important to note that there are multiple stacked tables on these sheets, but each table only ever has ONE value in the B column, and I'm only ever looking for the most recent one.
Is there a way to tell excel not to count blank table rows as used rows? I'm only interested in returning the last value in column B, even if it may not be the last table row.
Dim rng As Range
Dim cell As Range
Dim result As String
Dim result_sheet As Long
Dim LastRow As Long
Set rng = Range("A2:A200")
For Each cell In rng
result = cell.Value
LastRow = Worksheets(result).Cells(Worksheets(result).Rows.Count, "B").End(xlUp).row
cell.Offset(0, 1).Value = Worksheets(result).Range("B" & LastRow).Value
Next cell
Here is one way
Sub Sample()
Dim ws As Worksheet
Dim tmplRow As Long, lRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
tmplRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = tmplRow To 1 Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
If lRow = 0 Then lRow = 1
MsgBox "The last row is " & lRow
End With
End Sub
Screenshot
And another way
Sub Sample()
Dim ws As Worksheet
Dim tbl As ListObject
Dim lRow As Long, endRow As Long, startRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Change this to the relevant table number
Set tbl = .ListObjects(1)
endRow = tbl.Range.Rows.Count
startRow = tbl.Range.Row
For i = endRow To startRow Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
MsgBox lRow
End With
End Sub
I have an excel chart with a bunch of data
Every few rows is blank
When there is a blank row I would like to concatenate the cells in column A and last 4 characters of column B from the row below, as long as the cell in column A below does not equal "."
I have the following:
Sub Macro3()
'
' Macro3 Macro
'
'
For Each cell In Columns("A")
If ActiveCell.Value = "" Then ActiveCell.FormulaR1C1 = _
"=IF(R[1]C<>""."",CONCATENATE(R[1]C,RIGHT(R[1]C[1],4)),"""")"
Range("A2").Select
Next cell
End Sub
Why entire Col A?
If you are using the cell object to loop then why use ActiveCell?
My recommendation is to find the last row in Col A and then take that into account in identifying your actual range and then loop through that.
Is this what you are trying?
Sub Sample()
Dim aCell As Range
Dim lRow As Range
Dim ws As Worksheet
'~~> Change this to the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Last row in col A which has data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Check each cell in the relevant range
For Each aCell In .Range("A1:A" & lRow)
If aCell.Value = "" Then _
aCell.FormulaR1C1 = "=IF(R[1]C<>""."",CONCATENATE(R[1]C,RIGHT(R[1]C[1],4)),"""")"
Next aCell
End With
End Sub