I currently have a large Excel file where the data doesn't line up with the corresponding headers.
In order to fix this I need to cut and paste all of the rows where column "A" contains "Planned" up one row and four columns to the right. I have a few thousand rows that need to be moved (with VBA). I have been working on piecing together some code but with no avail (I have limited knowledge of VBA).
The below shows a snapshot of the data I am working with. I need the yellow row to be moved to the red area. The green row on top is an example of what it looks like after manually making the change. Hopefully this code would loop through the whole sheet give me data that lines up with their respectful headers.
(the row of yellow data that needs to be moved is 60 columns wide by the way, the picture only shows a small snapshot of the worksheet)
Quick & dirty, untested solution. Give it a go.
Dim cel as range
For each cel in Range("A1:A" & Range("A1").end(xldown).row
if cel.value = "Planned:" then
cel.resize(1,60).cut
cel.offset(-1,4).pastespecial xlpasteall
end if
next cel
You can try this method (without VBA)
select the destination region (red region)
hit Ctrl+g then click the Special button
choose Blank, click Ok
type in the reference formula (e.g. in E3 the formula be =A4) and hit Ctrl+Enter to fill all
copy paste the entire red column as value (i.e. remove the formula)
filter column A for value Planned: and delete the rows.
I know this has a drawback, on step 6 if your data is VERY LARGE, Excel might fail to delete filtered rows properly
This short procedure should take care of the aberrant import data while shifting the now-empty 'planned' lines up.
Sub fix_planned()
Dim rw As Long
With Worksheets("Sheet1")
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If LCase(Left(.Cells(rw, 1).Value2, 8)) = "planned:" Then
.Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Copy _
Destination:=.Cells(rw, 1).Offset(-1, 4)
.Rows(rw).EntireRow.Delete
End If
Next rw
End With
End Sub
Suggest you fix the source of the data so you do not have to repeatedly repair the data 'after-the-fact'.
Related
Ok, back again!
I have tried to search throught this and other forums to find a similar solution, but everything Ive found is either just different enough that I cant figure out the application to my problem, or super complex, and I cant translate it! So Im hoping someone can help me here. Thanks in advance!!
Here is the scenario. I have a database that Im needing to add data to. Quote Number, PO Number,SubSystem Part Name, Vendor, Material, Price, Qty. Etc.
Long story short, and without getting into the context of why I did it this way (mostly because I think I would botch the explaination and be more confusing than helpful!) ... I have essentially 3 tables right next to each other.
Table 1 is columns H and I. These all have a formula similar to =if(isblank(J4),"",$I$1) Where I1 is the PO Number (which will remain the same for this set of entries.)
Table 2 is a pivot table in columns J through M. Using a slicer the user can select what sub systems they need for this PO. The pivot table will repopulate with the appropriate part numbers and unique information contained in another table.
Table 3 is a regular table in columns N through R. These columns have some formulas like above that pull from a single cell (for entering the date), some pull information from another table based on information in column J via a VLOOKUP, and some information is entered manually.
That might be too much information, but better to have it and not need it eh?
So heres the goal. With a VBA macro, I want to copy the data and paste it onto another sheet, at the bottom of a database. The trick is, because that whole setup above runs based on information coming from a pivot table, the list changes length constantly. It will never be longer than a certain length (still TBD) but will almost always be shorter. I can copy the whole thing, and have it paste to another sheet below the last entry... but it pastes below the last empty cell in the database sheet. What I mean is this:
The longest the table could be would be range H4:R38 for example. So I copy that, paste it to Sheet2 starting at cell A2. Upon further inspection, we see that there is only actual data in the range H4:R11. However, when we pasted it to Sheet2 it pasted the whole range H4:R38. When I run the macro again, instead of the new data set being pasted to row A10 (the row after where the data should have ended), it pastes to something like row 36... because its pasting below all the blank cells.
I have no idea what to do or where to start. Any help would be greatly appreciated! Thanks so much!
Code I've Tried:
Dim fabricationrange As Range
Dim destination As Range
Dim LastBBUFabDatabaseRow As Long
Worksheets("Sub Systems").Range("h4:r38").Copy
With ThisWorkbook.Sheets("BBU Fab. Database")
Worksheets("bbu fab. database").Range("z" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
lastbbufabdatabserow = .Cells(.Rows.Count, 2).End(xlUp).Row = 1
Set destination = .Cells(LastBBUFabDatabaseRow, 2)
destination.Value = PasteSpecial.Values
End With
Untested but here's a brute-force approach to locating the first empty row:
set rngDest = ThisWorkbook.Sheets("BBU Fab. Database").rows(2) '<< start here
do while application.counta(rngDest) > 0
set rngDest = rngDest.offset(1, 0) 'next row
loop
Worksheets("Sub Systems").Range("H4:R38").Copy
rngDest.cells(1).PasteSpecial xlPasteValuesAndNumberFormats '<< paste to col A
Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7
I found this great snip of code and I am trying to manipulate it to work for me, but I just can't seem to get it. Unfortunately I haven't been able to get my head around it to fully understand it, which doesn't help. So I turn to you. I need to evaluate a column of cells and look for either similarities or differences. If a cell in sheet 1 column 1 is not the same as any of the cells in sheet 2 column 1, I want to copy the entire row into sheet 1 at the bottom of the used area. I've gotten this to the point where what you see will copy the correct first cell, but I can't manipulate it to copy the entire row. I think because of how the 'With' is structured but I need to try to stay away from doing loops since there is over 30k cells to evaluate.
Going down the road I will also be wanting to look for duplicates using the same method above, and if there is a duplicate, compare the adjacent cells for differences and if there is a difference, move the existing data into a comment and move the new data into the existing cell.
Any and all advice is, as always, very appreciated.
Sub Compare_Function()
Call Get_Master_Cell_Info
Application.ScreenUpdating = False
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Quick line by line breakdown
This just takes the entire used range from cells A4 to the last used cell in columnA then offsets it by one column so B4:Bx (x is the last used row in column A)
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
This puts the formula in all cells so it looks up A4,A5,A6, etc in master sheet, returns the value in the master sheet or an error if its not found. It then copies the values over so they are hardcoded in
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
Specialcells looks for constants (all cells) and value 16 which means error cells (ie cells don't exist) offsets by -1 (so column A) and copies to new sheet column A at rows.count+1
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You might also want to do this after you .clearcontents so you don't get all the error cells in column B
to fix it just change the copied range to .entirerow so
.SpecialCells(xlCellTypeConstants, 16).entirerow.Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You will also copy the errors in column B but with this structure there is no getting around that. Can always erase them from the master sheet after.
Also note this code will overwrite any data you have stored in column B.
One more note this code depends on the sheet update being active, it won't run otherwise since your cells function inside your range needs the worksheet explicitly stated, as does your rows.count. You would be better wrapping the whole thing in 2 withs, one for the sheet and one with the range (using .cells and .rows.counmt)
I have data on multiple sheets in a workbook that I want copied all to one sheet in that same workbook. When I run the macro, I would like it to start by deleting the current data in the "iPage Data Export" sheet and then replacing it with data from the other sheets.
I want the process to occur one column at a time since I may not bring over everything. Right now I am trying to learn how to do just one column.
I was able to get it to copy all of the contents of a column from one sheet, but when it moves to the next sheet, it overwrites the existing data. In the end, I only get one sheets worth of data copied.
Here are my 4 problems:
How do I make it clear the data on this sheet before running the routine?
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
How can I make it copy to a particular column (currently it just seems to default to A.
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Select
Range("C:C").Copy
Sheets("iPage Data Export").Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub
How do I make it clear the data on this sheet before running the routine?
Sht.Cells.ClearContents
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
In detail:
Rows.Count will return the number of rows in the sheet, so in the legacy style *.xls workbooks this would return the number 65,536. Therefore "C" & Rows.Count is the same as C65536
Range("C" & Rows.Count).End(xlUp) is the same as going to C65536 and pressing Ctrl + ↑ - The command End(xlDirection) tells the program to go the last cell in that range. In this case, we would end up at the last cell containing data in column C.
.Offset(1, 0) means that we want to return the range offset by an amount of rows and/or columns. VBA uses RC (Rows Columns) references, so whenever you see something like the Offset() function with two numbers being passed as the arguments, it usually relates to the row, and the column, in that order. In this case, we want the cell that is one row below the last cell we referenced.
All-in-all the phrase Range("C" & Rows.Count).End(xlUp).Offset(1, 0) means go to the last cell in column C, go up until we hit the last cell with data, and then return the cell below that - which will be the next empty cell.
How can I make it copy to a particular column (currently it just seems to default to A.
Range("C:C").Copy Destination:=Sheets("iPage Data Export").Range("A:A")
You can pass the Destination argument in the same line and actually bypass the clipboard (faster and cleaner)
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Lets say you wanted to reference column A, B, and F - just use:
Range("A1, B1, F1").EntireColumn
To summarise, you could streamline your existing code to something like (untested):
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Range("C1:C" & Cells(Sht.Rows.Count, 3).End(xlUp).Row).Copy Destination:=Sheets("iPage Data Export").Range("A:A")
End If
Next
End Sub
This should do for the copying:
Sub CombineData()
Dim sheet As Worksheet
For Each sheet In Worksheets
If (sheet.Name <> "iPage Data Export") Then
sheet.Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("iPage Data Export").Activate
Cells(1, ActiveCell.SpecialCells(xlCellTypeLastCell).Column + 1).Select
ActiveSheet.Paste
End If
Next
End Sub
For the concatenation you need to be more specific - but I guess you should open a new question with a clearer focus if you need specific help on that.
I got an spread sheet that include formulas and I wrote a vb code to value paste.
Depending on the input file number of rows that filled is varied and I need to delete the rows those had formulas and now empty. (This is using as connector and otherwise it some how pick these extra rows which is unnecessary)
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Above code not doing anything...
If the blanks are results of a formula like:
=""
Entered into a cell and then copied and paste as values, those are not really blank cells.
Instead, those are cells that looks blank but contains zero length strings.
SpecialCells(xlCellTypeBlanks) and even Excel formula ISBLANK won't work on it.
One way is to loop through the range and check all that contains "" and delete it.
Dim c As Range, rngtodelete As Range
For Each c In Sheet2.Range("G2:G298")
If Len(c.Value) = 0 Then
If rngtodelete Is Nothing Then Set rngtodelete = c _
Else Set rngtodelete = Union(rngtodelete, c)
End If
Next
If Not rngtodelete Is Nothing Then rngtodelete.EntireRow.Delete xlUp
Another way is using AutoFilter like this:
Sheet2.Range("G2:G298").AutoFilter 1, "="
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
I'm assuming that G2 does not contain your header but the start of your data.
If it happens to be your header, you'll need to use offset when deleting.
Sheet2.Range("G2:G298").Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
Sheet2.AutoFilterMode = False
I'm not completely sure what you mean by "This is using as connector", but I believe it has to do with an export/import process to another application.
As mentioned, a zero length string is not the same as a truly blank cell. However, you can rid your worksheet of them easily. The fastest method I am aware of is a quick cyclic run through all of the columns, applying Text-to-Columns ► Fixed width ► Finish to each.
When that is done, the zero length strings will be reverted to truly blank cells but the worksheet's used range will still overlap those empty cells found at the bottom of the dataset. This means that any export to an external program will try to export those cells. Just run .UsedRange to get Excel to reevaluate the actual used range.
First, tap Ctrl+End to see what Excel thinks is the last used cell on the worksheet. Next, run the following macro.
Sub prep_for_export()
Dim c As Long
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
With Sheets("Sheet1")
For c = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns(c).TextToColumns Destination:=.Cells(1, c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
Sheets("Sheet1").UsedRange
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
End Sub
Edit Sheet1 in all four places if you have to before running it.
That is a little homogeneous but I think it should work for your purposes. After running the macro, tap Ctrl+End back at your worksheet again to see what Excel thinks is the last used cell on your worksheet. The before and after range addresses were recorded to the VBE's Immediate window as well.