Trying to write a script to delete all cells in a row except the last used cell, then move all remaining data to the first column.
See below:
|--| is an empty cell
|XX| is a cell with unneeded data
|DATA| is the cell with Data I require.
Before:
|--|--|--|XX|XX|XX|XX|DATA|
|--|--|XX|XX|XX|DATA|
After
|DATA|
|DATA|
Assuming you meant in Excel:
Process:
Loop over the sheet
Set a tempVal variable to the value of the lastColumn
Loop through the columns to the last column for that row, clearing each cell
Set the value of column A to the tempVal
TESTED:
Sub GetLastColumnValue()
Dim lastRow As Long
Dim lastCol As Long
Dim sheet As String
Dim tempVal As String
sheet = "Sheet1"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Using Range()
For lRow = 2 To lastRow
lastCol = Sheets(sheet).Cells(lRow, Columns.Count).End(xlToLeft).Column
tempVal = Sheets(sheet).Cells(lRow, lastCol).Text
For lCol = 1 To lastCol
Sheets(sheet).Cells(lRow, lCol).ClearContents
Next lCol
Sheets(sheet).Cells(lRow, 1) = tempVal
Next lRow
End Sub
Related
I am trying to populate each row of a column with 1 from the 2nd row after the header to the last row.
The column is "Ok to call" in a worksheet named Adults.
This code creates the column in the correct worksheet that I need but does not populate the rows with 1. I believe I have to add in the last row but don't know how. Appreciate any help!
Dim shtA As Worksheet
Set shtA = ActiveWorkbook.Sheets("Adults")
Dim LastCol As Long
LastCol = shtA.Cells(1, Columns.Count).End(xlToLeft).Column
Dim lastRow As Long
lastRow = shtA.Cells(Rows.Count, 1).End(xlUp).Row
'Loop through heading row to get column number of "Ok to call?"
Dim okcall As Long
Dim a As Long
For a = 1 To LastCol
If LCase(shtA.Cells(1, a).Value) = "ok to call?" Then
okcall = a
Exit For
End If
Next a
Added this after PeterT's suggestion:
For a = 1 + 1 To lastRow
shtA.Cells(a, okcall).Value = 1
Next a
End
I have a excel which has multiple rows and columns and range of column values differ for each row.
Need a macro which will delete all cells in a row except first and last in each row and paste the last value next to first value.
Tried the below script:
Sub test()
Dim sh As Worksheet
Dim IDS As range
Dim ID As range
Set sh = ThisWorkbook.Sheets("Sheet1")
Set IDS = ActiveSheet.range("A2", range("A1").End(xlDown))
For Each ID In IDS
Dim b As Integer
Dim k As Integer
k = sh.range("ID", sh.range("ID").End(xlToRight)).Columns.Count
b = k - 1
range(ID.Offset(0, 0), ID.Offset(0, "b")).Select
Selection.ClearContents
Next ID
End Sub
This is a little different approach but should help.
Also, it is generally not best to declare variables in a loop as you do with b & k just fyi
Sub test()
Dim sh As Worksheet
Dim row As Integer
Dim lastCol As Integer
Set sh = ThisWorkbook.Sheets("Sheet1")
For row = 2 To sh.Cells(Sheets(1).Rows.Count, "A").End(xlUp).row
lastCol = sh.Cells(row, Columns.Count).End(xlToLeft).Column
sh.Range("B" & row).Value = sh.Cells(row, lastCol).Value
sh.Range(sh.Cells(row, 3), sh.Cells(row, lastCol)).ClearContents
Next
End Sub
Best of luck
I'd go as follows:
Sub test()
Dim cell As Range
With ThisWorkbook.Sheets("Sheet1") ' reference relevant sheet
For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) ' loop through referenced sheet column A cells from row 2 down to last not empty one
With .Range(cell, .Cells(cell.Row, .Columns.Count).End(xlToLeft)) ' reference referenced sheet range spanning from current cell to last not empty one in the same row
If .Count > 2 Then ' if referenced range has more then 2 cells
cell.Offset(, 1).Value = .Cells(1, .Count).Value ' store last cell value next to the current one
.Offset(, 2).Resize(, .Columns.Count - 1).ClearContents 'clear all cells right of current one
End If
End With
Next
End With
End Sub
You can use Range.Delete Method (Excel)
range(ID.Offset(0, 0), ID.Offset(0, b)).Delete Shift:=xlToLeft
So I've got an Excel workbook with multiple worksheets. Each worksheet is the same template. And cells B3 - B39, C3 - C39, and D3 - D39 will contain 1 of 3 values. 1, .5, or no value at all (completely blank). Now each worksheet isn't exactly the same (some will go to B/C/D45 instead of just B/C/D39). I'm trying to have another cell show how many of those cells contain a 1, and another cell show how many contain a .5. Yeah I could manually do it, but I'm trying to get this as automated as possible.
As #Variatus has suggested, you could just use the COUNTIF worksheet function, but if you wanted to do this with VBA, what you need to do is:
Method
Identify the last row
Build the range
Count how many of the cells in this range contain 1
Count how many of the cells in this range contain .5
Do something with these counts
Code
Sub CountTheSheets()
Const Value10 As Double = 1, Value05 As Double = 0.5 ' these are what we're comparing cell values against
Dim Count10 As Long, Count05 As Long ' these are our 1 and .5 counts respectively
Dim lastRow As Long, lastRowTemp As Long, maxRow As Long
Dim ws As Worksheet
Dim cel As Range
For Each ws In ThisWorkbook.Worksheets ' iterate over all worksheets
lastRow = 0 ' reset the last row for this worksheet
Count10 = 0 ' reset the 1 count for this worksheet
Count05 = 0 ' reset the .5 count for this worksheet
With ws
maxRow = .Rows.Count ' this is the absolute bottom row in a worksheet
' get last row of column B, by going to the bottom of the worksheet in that column, then using End and going up to find the last cell
lastRowTemp = .Cells(maxRow, "B").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' get last row of column C; if larger than the previous, store in lastRow that row number instead
lastRowTemp = .Cells(maxRow, "C").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' get last row of column D; if larger than the previous, store in lastRow that row number instead
lastRowTemp = .Cells(maxRow, "D").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' build the range using lastRow, and iterate through the cells in that range, counting the matching values
For Each cel In .Range("B3:D" & lastRow)
If cel.Value = Value10 Then
Count10 = Count10 + 1
ElseIf cel.Value = Value05 Then
Count05 = Count05 + 1
End If
Next cel
' do something with these counts
Debug.Print .Name, Count10, Count05
End With
Next ws
End Sub
I'm a new user and can't embed images yet... please see the links.
Say my data looks like this: Before. And, I'd like it to look like this: After. Here's the code I've been trying (unsuccessfully):
Dim lastRow As Long
lastRow = Range("Sheet2!A" & Rows.Count).End(xlUp).Row
Dim col As Integer
col = Range("Sheet2!A1:A" & lastRow).End(xlToRight).Column
Columns(col).Copy
Columns(col + 1).Insert Shift:=xlToRight
I'd like the macro to work on a dataset with any number of rows, hence the lastRow stuff. Any ideas?
How's this work?
Sub move_data()
Dim lastRow As Long, lastCol As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastCol = ws.UsedRange.Columns.Count
Dim i As Long
For i = 1 To lastRow
If ws.Cells(i, lastCol) = "" Then
ws.Cells(i, ws.Cells(i, 1).End(xlToRight).Column).Cut ws.Cells(i, lastCol)
End If
Next i
End Sub
I hesitate to use UsedRange, but if your data does exist in a "block" that should work okay. Basically, it just checks each row, and if that last column is empty, move the last cell from column A to that column.
I have different data on multiple rows and columns in Excel and I want all the data to be on a single Column. I tried the Transpose Function but it's not helping me to get what I want.
This is what I have right now:
And this is what I want to get:
Can anyone kindly tell me how I can achieve that? Any built in function or Macro will be helpful. Thanks.
Try this code:
Sub RangetoColumn()
Dim LastRow As Long, LastColumn As Long
Dim CurrentSheet As Worksheet, TargetSheet As Worksheet
Dim i As Long, j As Long, Count As Long
Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")'-->change Sheet1 to your source sheet
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")'-->change Sheet2 to your target sheet
LastRow = CurrentSheet.Cells(Rows.Count, "A").End(xlUp).Row
Count = 1
For i = 1 To LastRow
LastColumn = CurrentSheet.Cells(i, Columns.Count).End(xlToLeft).Column
For j = 1 To LastColumn
TargetSheet.Range("A" & Count).Value = CurrentSheet.Cells(i, j).Value
Count = Count + 1
Next j
Next i
End Sub
Code will read Range from Sheet1 and will create a Column in Sheet2.
I think this tutorial should help you : tutorial
you can try that solution for your needs.
Try using & in both cells. Try like this A1&B1 to combine the data in cell A1 and cell B1; copy and paste, then enjoy.
this will have all current sheet cells listed down its column A and cleared all other adjacent columns
Option Explicit
Sub RangeToOneColumn()
Dim lastRow As Long, i As Long, j As Long
Dim rng As Range
Dim myArr As Variant
With ThisWorkbook.Worksheets("Sheet1") '<== change it to your needs
lastRow = .Cells(.rows.Count, "A").End(xlUp).Row
ReDim myArr(0 To lastRow - 1)
For i = 1 To lastRow
Set rng = .Range(.Cells(i, 1), .Cells(i, .Columns.Count).End(xlToLeft))
myArr(i - 1) = Application.Transpose(Application.Transpose(rng))
Next i
.Cells(1, 1).CurrentRegion.ClearContents
j = 1
For i = LBound(myArr) To UBound(myArr)
.Cells(j, 1).Resize(UBound(myArr(i))) = Application.Transpose(myArr(i))
j = j + UBound(myArr(i))
Next i
End With
End Sub
since it uses array, it runs faster than iterating a coping&pasting through cells