ExcelSheetImage
I want to populate the cells until the last row and the last column. The number of columns and rows vary for each excel sheet I am going through.
So far I have the code below for populating all the rows in column C but it doesn't compile
Sub populate()
Dim lastrow, lastcol As Long
lastrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1 'finds last row in B
Range(lastrow, 3).Formula = "=sum(A2:B2)" 'populates cells in C with formula
until last row
End Sub
Range expects two cells a start and an end or a string. Cells take a row and column
Sub populate()
Dim lastrow, lastcol As Long
lastrow = Sheet1.Cells(Sheet1.Rows.Count, 2).End(xlUp).Row + 1 'finds last row in B
Sheet1.Range("C2",Sheet1.Cells(lastrow, 3).Formula = "=sum(A2:B2)" 'populates cells in C with formula
End Sub
Related
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
Maybe somebody can help me with this one very basic problem that I have which is driving me nuts. I just need to copy some data from one sheet to another one depending on its output.
The variables have been defined previously and wMod and wRes stand for worksheets, countP and countC stands for the total amount of cells calculated in another worksheet.
What I need to do is to write a code that would be able to copy data with the value in cell B which has the number 1 in it, paste and paste it in another sheet. When I write the code below though, I only get in column A, sheet wRes the total amount of cells that were stored in variable countP.
You can see what kind of output I get below with the picture I attached.Data output Anybody has any idea why I cannot get the right output? Been stuck with this problem for hours.
For i = 3 To countP
If wMod.Range("B" & i) = 1 Then
For j = 3 To countC1
wMod.Range("A" & i).Copy wRes.Range("A" & j)
Next j
End If
Next i
The following code will check the Last Row with Data on Sheet1 Column A, then it will loop from row 2 to the Last and check if Column B = 1, then it will check the last row with data on Sheet2 Column A, and paste the value in the next row (ie. next empty row).
It goes like so:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim LastRow As Long
Dim LastRow2 As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'find the last row with data on Column A in Sheet1
For i = 2 To LastRow 'loop from row 2 to last
If ws.Range("B" & i) = 1 Then 'if column B in Sheet1 = 1 then
LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 'find the last row with data on Sheet2 Column A
ws2.Cells(LastRow2 + 1, 1) = ws.Range("A" & i)
End If
Next i
End Sub
I have a SAP report in Excel with over 10,000 rows. There are 2 columns - A & B. A is value in $ and B is ref for the value. The SAP report shows subtotals by reference type but the subtotal ref cell B is always empty. I need to copy the cell above the empty cell into the empty cell (into the same row as the subtotal). e.g. A1:A5 has values 3,2,3,1,1 so the subtotal is 10 and it's in A6. the cell in B6 is empty. The ref type in B5 is 12kg Bag. I need to copy this ref into Cell B6. the reason why i do this is because i filter the report by subtotal to copy to another file. At the moment I'm doing this manually and it takes ages. I'm guessing it's a loop code until the last row as the rows vary each time i run the report. Thank you!
Is this what you're looking for? This sub loops over all rows and checks if the cell in column B is empty but the cell in column A contains a value. If so, it copies the cell in column B from the previous row into the current row.
Sub fillEmptyCells()
'copies the above cell for each empty cell in B where the cell in A is not empty
Dim i As Integer
Dim lastRow As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
lastRow = ws.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 'This gives the last Row with a nonempty cell in column A
For i = 1 To lastRow
If IsEmpty(ws.Cells(i, 2)) And Not IsEmpty(ws.Cells(i, 1)) Then
ws.Cells(i - 1, 2).Copy ws.Cells(i, 2)
End If
Next i
End Sub
Edit: here is the same sub with a with environment
Sub fillEmptycells()
'copies the above cell for each empty cell in B where the cell in A is not empty
Dim i As Integer
Dim lastRow As Integer
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'This gives the last Row with a nonempty cell in column B
For i = 1 To lastRow
If IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 1)) Then
.Cells(i - 1, 2).Copy .Cells(i, 2)
End If
Next i
End With
End Sub
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
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub