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
Related
I have two sheets , Sheet1 and sheet2 .
Sheet 1 is my Source sheet and I am mentioning the item number in column A.
Sheet 2 is my destination sheet the contains the list of item number from the data base.
I am comparing the column A of source sheet with column E of my destination sheet, if they both have same item number then I am deleting the entire row.
I am using the below code for this. on 6 item number 4 are getting deleted and 2 are not getting deleted.
But, when I copy the same item number from the destination sheet to source sheet ,then it is getting deleted. I am not sure why this is happening. Could any one guide how I could figure this out.
below is the code
Sub spldel()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("sheet1")
Set destWS = ThisWorkbook.Sheets("sheet2")
srcLastRow = srcWS.Cells(srcWS.Rows.count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.count, "E").End(xlUp).Row
For i = 5 To destLastRow - 1
For j = 1 To srcLastRow
' compare column E of both the sheets
If destWS.Cells(i, "E").Value = srcWS.Cells(j, "A").Value Then
destWS.Cells(i, "E").EntireRow.delete
End If
Next j
Next i
End Sub
Remember to loop in reverse order when you are trying to delete the rows otherwise rows may skipped from deletion even when they qualify the deletion criteria.
So the two For loops should be like this....
For i = destLastRow - 1 To 5 Step -1
For j = srcLastRow To 1 Step -1
Here is another approach:
Rather than looping through each item everytime in your source and destination sheets, just use MATCH function:
Function testThis()
Dim destWS As Worksheet: Set destWS = ThisWorkbook.Worksheets("Sheet8") ' Change to your source sheet
Dim srcWS As Worksheet: Set srcWS = ThisWorkbook.Worksheets("Sheet12") ' Change to your destination sheet
Dim iLR As Long: iLR = srcWS.Range("L" & srcWS.Rows.count).End(xlUp).Row ' Make sure you change the column to get the last row from
Dim iC As Long
Dim lRetVal As Long
On Error Resume Next
For iC = 1 To iLR
lRetVal = Application.WorksheetFunction.Match(srcWS.Range("L" & iC), destWS.Range("A:A"), 0)
If Err.Number = 0 Then
destWS.Range("A" & lRetVal).EntireRow.Delete
End If
Err.Clear
Next
On Error GoTo 0
End Function
I have a matrix with lots of rows which do have different row lengths. As you can see in the image below, row 3 ends at column T, whereas row 8 ends at column L. What I am trying to do is to loop through every row of the matrix with the fleet name "Taxi" and sum up every entry.
How can I accomplish this? The main problem I face is with iterating through the rows and finding the end of the row dynamically and how to filter the table beforehand by the fleetname.
Code does what you want
Dim sht As Worksheet
Dim LastColumn As Long
Dim LastRow as Long
Dim i as Long
Dim dblSum as Double 'your sum
Set sht = ThisWorkbook.ActiveSheet
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i=2 to LastRow
If .Cells(i,1).Value = "Taxi" Then
LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
dblSum = Application.Sum(.Range(.Cells(i, 2), .Cells(i, LastColumn)))
End if
Next i
End with
Set sht = Nothing
I'm trying to write a loop that searches every filled cell in column "J" in sheet2, and hides the corresponding row in sheet1. For example, if cell J1 was "30", row 30 in sheet1 would be hidden. Here's what I have so far:
Sub test()
Dim myrng As Range
Dim ws As Worksheet
Dim i As Integer
Dim lrow As Long, value As Long
Dim cell As Variant
Set ws = Sheet2
lrow = ws.Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To lrow
value = ws.Cells(i, 10).value
cell = "A" & value
Sheet1.[cell].EntireRow.Hidden = True
Next i
End Sub
Everything is working except for the line "Sheet1.[value].entirerow.hidden=true". I'm probably using incorrect syntax. Any thoughts/help would be much appreciated!
Thanks,
Kim
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
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