Trying to delete the last two rows in a macro that formats the sheets in a specific way. Everything else works fine except the last two rows of the data do not get deleted
My entire code is:
Sub Format()
'Firstly convert all text cells into number cells for every sheet in workbook
Application.ScreenUpdating = False
For Each ws In Sheets
On Error Resume Next
For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants)
If IsNumeric(r) Then r.Value = (r.Value) * 1
''Or test the values in the next column on the right
'If IsNumeric(r) Then r.Offset(0,1).Value = (r.Value)*1
Next r
'Remove excess columns and rows
Dim lastRow As Long
'Find last row in column A
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'Remove Last 2 rows with data
ws.Rows(lastRow - 1 & ":" & lastRow).Delete
'Delete rows and columns
ws.Rows("1:15").Delete
ws.Columns("A").Delete
Next ws
Application.ScreenUpdating = True
End Sub
this is the code I'm trying to use to delete the last two rows in each sheet:
Dim lastRow As Long
'Find last row in column A
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'Remove Last 2 rows with data
ws.Rows(lastRow - 1 & ":" & lastRow).Delete
Related
I am stuck i don't know what code to use so i can search the same column twice for 2 different keyword and then copy data from the same row to another spreadsheet in sequence from a start cell. for details here's what i am trying to do.
Limit the search within a range of the worksheet (ex. Sheet 1 B1:N:200)
Search the 8th column (I) of the limit range Sheet1 for keyword ("Goods")
Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Goods " is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) on a specific starting point (ex. Sheet 2 - B3) Next Match Result will be Sheet 2 - B4 and so on
5.Search AGAIN the 8th column of Sheet1 for keyword ("Services") starting from the top (B1:N1)
6.Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Services" is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) to next row after the last PASTE from "Goods" was done. (ex last row match paste was C35 and D35 new found value should be paste in C36 a D36)
Ending Output should be all "Goods" results first then "Services" results
I hope i have conveyed what i need clearly
I am trying to work on this code that i found here but i just don't get how to insert the 2nd search loop for services., how to paste on specific cell in sheet2, how to follow the last row for services paste
Sub CopyCells
Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long
With Worksheets(1)
lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
For counterSht1 = 1 To lngLastRowSht1
For counterSht2 = 1 To lngLastRowSht2
If Sheets(1).Range("" & (counterSht1)).Value = "Goods" Then
Sheets(2).Range("B" & (counterSht2), "D" & (counterSht2)).Value = Sheets(1).Range("C" & counterSht1, "D" & counterSht1).Value
End If
Next counterSht2
Next counterSht1
End With
End Sub
Edit1
As per request of sir Chris this is how it should look like
Answer for this Query was best solved by #CDP1802 Worked as needed.
I learned that I needed 2 counters for it to work :) and I also learned how to properly label target destination.
Thank you for this community:)
Increment the target row after each copy.
Option Explicit
Sub CopyCells()
Const ROW_START = 3
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
Dim keywords, word, t0 As Single: t0 = Timer
keywords = Array("Goods", "Services")
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lastrow2 = ROW_START
Application.ScreenUpdating = False
With ws1
lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
For Each word In keywords
For r = 1 To lastrow1
If Len(.Cells(r, "I")) = 0 Then
Exit For
ElseIf .Cells(r, "I") = word Then
'Sht1 col 2 to Sht2 Col 3 (no format values only)
'Sht1 col 5 to Sht2 Col 4 (with format and values)
ws2.Cells(lastrow2, "C") = .Cells(r, "B")
ws2.Cells(lastrow2, "D") = .Cells(r, "E")
.Cells(r, "E").Copy
ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
lastrow2 = lastrow2 + 1
n = n + 1
End If
Next
Next
End With
Application.ScreenUpdating = True
MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
You could make two routines: one for services and one for goods. But that code and the code above isn't very efficient.
Since Services & Goods are in the same column, try using the autofilter:
Sheets(2).UsedRange.autofilter Field:=8, Criteria1:=Array("Goods", "Services"), VisibleDropDown:=False, Operator:=xlFilterValues
Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False
How can I cycle through sheet1 to see if there is data in that cell?
If there is no data then go to the next cell.
If there is data in the next cell paste it into sheet2.
The criteria are:
I cannot use a set range it will change as the data changes in sheet1.
I can keep sheet names a constant such as sheet1 and sheet2.
I found a way using columns and or rows yet that code has a major issue. If there is no starting data in the first cell it will not copy anything in the entire row and or column.
I am posting the code I worked with to check the data in columns but if there is no starting data it will skip the whole row.
Sub CopytoImport()
Dim wb As Workbook
Dim iCol As Long
Dim ws As Worksheet
Sheets("sheet2").Cells.ClearContents
' Loop through the column
For iCol = 1 To 22 ' Call out columns I cannot set this every time it should look threw all cells
With Worksheets("sheet1").Columns(iCol)
' Check tht column is not empty
If .Cells(1, 1).Value = "" Then
'Nothing in this column
'Do nothing
Else
' Copy the coumn to te destination
Range(.Cells(1, 1), .End(xlDown)).Copy _
Destination:=Worksheets("sheet2").Columns(iCol).Cells(1, 1)
End If
End With
Next iCol
ActiveWorkbook.Save
End Sub
Function runcode()
Call CopytoImport
End Function
Cells(1, 1) is just RANGE.("A1") you are only operating on this cell in your code. You would need Cells(1, iCol) to account for what column you are on during your loop.
You might also need a nested loop since you are looping through rows as well. The basic outline of a nested loop is as follows. Note the Cells(1,1) is replaced with the i and j representing what row and what column we are on. This might not be the fastest way to achieve the results you want but it sounds like this is what you are asking for help with. You will also need to define a lastrow (with a + 1 at the end to get the next blank cell) in your Sheet2 for when you paste the data. You would put this right under where the loop starts going through rows. This is so the lastrow of your sheet2 is recalculated each time data is being moved to that sheet. I am not going to re-write your code since you stated it is not complete but here is an example that should help you.
For j = 5 To lastcolumn
For i = 5 To lastrow
Dim lastrow2 As Long
lastrow2 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
If Worksheets(2).Cells(i, j).Value <> 0 Then
Worksheets(1).Range("C" & lastrow2).Value = Worksheets(2).Cells(i, j).Value
Worksheets(1).Range("B" & lastrow2).Value = Worksheets(2).Cells(2, j).Value
End If
Next i
Next j
To find your lastrow:
dim lastrow as long
lastrow = Range("A" & rows.count).End(xlup).Row ' or whatever column contains the data
To find your last column
Dim lastcolumn As Long
lastcolumn = Worksheets(2).Cells(2, Columns.Count).End(xlToLeft).Column
I need to copy all the text values from Column F on +10 sheets and place them in a single Column on an aggregate sheet. I do not need to perform any computation on the data, just copy the text values derived from formulas. For example:
Sheet1 Col F:
1
2
3
Sheet2 Col F:
4
5
6
I would like "Master" Col A be:
1
2
3
...
6
This code gets me mostly there, but I need the Range to vary. For instance, not every sheet has 3 rows of data, but I want them to be copied directly after each other.
Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
If ws.Name <> "Master" Then
ws.Range("F1:G15").Copy
Sheets("Master").Range("A" & lr).PasteSpecial xlPasteValues
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next ws
End Sub
EDIT: Every sheet DOES have the same number of rows with a formula in them, but the Values vary from sheet to sheet. So I need some check that looks for a "" Value as the "last row" then move to the next sheet.
First of all, you can use the same logic to get the last row in the column "F" in each datasheet instead of hard-coding 3 rows usingrange.end(xlUp).Row method.
2nd I don't like the copy-paste method. it is slow and is very bothering you always calculate new insertion point and paste. You can utilize array in VBA to realize this functionality. And work with Array is very straightforward and fast.
Below is the code you can grab and use.
Sub MM1()
Application.ScreenUpdating = False
'Loop through worksheets, put the values in column F into arr array
Dim arr(1 To 10000), cnt As Integer, i As Integer
cnt = 0
For Each ws In Worksheets
If ws.Name <> "Master" Then
For i = 1 To ws.Cells(Rows.Count, "F").End(xlUp).Row
cnt = cnt + 1
arr(cnt) = ws.Cells(i, "F").Value
Next i
End If
Next ws
'Loop through arr array, populate value into Master sheet, column A
For i = 1 To cnt
ThisWorkbook.Sheets("Master").Cells(i, "A") = arr(i)
Next i
Application.ScreenUpdating = True
End Sub
only small changes and its working good :)
1. I changed the Master to Sheet5 => you can use your sheet name.
2. Added a new variable in loop to identify the range for each sheet to be copied.
3. Change the method to paste the copied data to destination.
Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
If ws.Name <> "Sheet5" Then
Dim currentRange As Long
currentRange = ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Range("A1:A" & currentRange).Copy Destination:=Sheets("Sheet5").Range("A" & lr)
lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next ws
End Sub
let me know if this works for you or not ?
I tried to keep your code as intact as possible. Here is one way to make it work (with as much preservation of your code as possible). There are still minor "touch ups" you would need to do (eg your "Master" sheet would have a blank row).
Sub MM1()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Master" Then
ws.Range(ws.Range("F1"), ws.Range("F1").End(xlDown)).Copy
Sheets("Master").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
Next ws
End Sub
I have two worksheets in one Excel workbook, and I only want to take the lines that have data in the cell (from worksheet1 into worksheet2) if Column A has data in it. My formula in worksheet 2 is =IF('Raw Data'!A2<>"", 'Raw Data'!A2,), but I actually don't want it to bring in the row at all if there is no data as shown in Rows 3 and 5. Right now it is bringing the whole row in:
In
you see that it is still bringing the row into worksheet 2 if there is no data. Any ideas how to only bring in the rows with the data?
Sub DataInCell()
Dim rw As Long
rw = 2
' Select initial sheet to copy from
Sheets("Raw Data").Select
' Find the last row of data - xlUp will check from the bottom of the spreadsheet up.
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' For loop through each row
For x = 2 To FinalRow
If Cells(x, 1).Value <> 0 Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet1").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 'Continue incrementing through the rows.
Cells(NextRow, 1).Select ' Find the next row.
ActiveSheet.Cells(NextRow, "A").PasteSpecial xlPasteAll ' Paste information.
Sheets("Raw Data").Select 'Reselect sheet to copy from. Probably uneccessary.
End If
Next x
End Sub
After you update the sheet names on the 3rd and 4th line, you will see that the code carries over the entire row. You can modify using Range(Cells, Cells) if you want partial ranges.
Option Explicit
Sub Non_Blanks()
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1") '<-- Master Sheet
Dim ns As Worksheet: Set ns = ThisWorkbook.Sheets("Sheet2") '<-- New Sheet
Dim i As Long, MoveMe As Range, LR As Long
For i = 2 To ms.Range("B" & ms.Rows.Count).End(xlUp).Row
If ms.Range("A" & i) = "*" Then
If Not MoveMe Is Nothing Then
Set MoveMe = Union(MoveMe, ms.Range("A" & i))
Else
Set MoveMe = ms.Range("A" & i)
End If
End If
Next i
If Not MoveMe Is Nothing Then
LR = ns.Range("A" & ns.Rows.Count).End(xlUp).Offset(1).Row
MoveMe.EntireRow.Copy
ns.Range("A" & LR).PasteSpecial xlPasteValuesAndNumberFormats
End If
End Sub
I am trying to copy certain cells if the word "FLAG" is a cell in that same row.
For example, I have data in excel like the following:
So if the word Flag is in any of the cells I want to copy the Description, Identifier and Final Maturity columns (Columns A-C) as well as the corresponding date column. So for the first row (AA) under Jan/Feb there is the word Flag. I would want to copy over columns A-E to another worksheet or table.
I would like to use a VBA but I am not sure how
The following code will do what you expect, each time it finds the word FLAG, the first 3 cells will be copied as well as the value for the given month will be copied to a new row, and if a second flag is found that will be copied to the next available row:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim wsResult As Worksheet: Set wsResult = Sheets("Sheet2")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 2 To LastRow 'loop through rows
For x = 15 To 23 'loop through columns
If ws.Cells(i, x) = "FLAG" Then 'if FLAG found in column
NextFreeRow = wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1 'get the next empty row of your wsResult sheet
ws.Range("A" & i & ":C" & i).Copy 'copy first three cells in given row
wsResult.Range("A" & NextFreeRow).PasteSpecial xlPasteAll 'paste into your Result sheet
ws.Cells(i, x - 11).Copy 'copy the value for which there was a flag
wsResult.Cells(NextFreeRow, 4).PasteSpecial xlPasteAll 'paste in the fourth cell in the sheet wsResult
End If
Next x
Next i
End Sub