Copy Range Excluding Blank Cells - Paste to Another Sheet - vba

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

Related

Move whole row based on column A to offset(-1,4)

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'.

VBA script for grouping columns

I've come across Stackoverflow many times when I've been looking for excel VBA scripting answers, but I've come up to a wall with my searching for an answer to my problem.
I have data which I need to sort, but it needs to be row grouped first, otherwise the sorting takes away the conformity of the info.
I want to group using info on just 1 column, and have found VBA scripts which do what I want except that they group 1 row to many. (if that makes sense)
i have info a little like
a b c d
Revise blank cell info info
blank cell blank cell info info
blank cell blank cell blank cell blank cell
Revise blank cell info info
blank cell blank cell info blank cell
Revise blank cell info info
etc etc
I want to group the top 3 rows, then the next 2.
but the only VBA script I found looks down the column for the word 'revise' but then groups the cells above the word revise, not below
I hope all that makes sense
thanks for any help
BTW, I dont really have any knowledge of programming, other than what I've gained through running some macros on other projects. Hopefully I wont need telling like a 5 YO, but may need some explanations of any code specific terms
I got this VBA script which works as I described
Option Explicit
Sub Macro2()
Dim rData, rCel As Range
Set rData = Range("a1", Range("a" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
With rData
On Error Resume Next
.Rows.Ungroup
.Rows.EntireRow.Hidden = False
On Error Goto 0
End With
For Each rCel In rData
If rCel = "END" Then Exit For
If rCel <> "Revise" Then
Rows(rCel.Row).Group
rCel.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub
Here's a quick and dirty non-VBA solution, as you say you are not overly familiar with VBA.
Add a column to the right of your data, which will hold a new index that tracks each time 'Revise' is listed in column A. Starting in A2 and copied down, this will look as follows [you may need to hardcode the first entry as 1]:
=if(A2="Revise",A1+1,A1)
This will create a column which increases by 1 each time there is a new "Revise". Then just select your entire data block, right-click, and Sort by your new index column.

How to copy data to an existing sheet without losing any data types or formatting

Here's the problem. I tried to build a simple regression test.
I have two sheets linked together and some other vba functionality.
In order to test regularly, I used copy-move-> make a copy and created precise copy of good sheet a then repeated with good sheetb and took a screenshot of how they should look when working correctly after I run my code.
All I have to do is copy in this known data, run the code then check the output against my screenshot. Or so I thought.
When I ran the code lots of things just changed themselves despite the fact that I a coping a range of data forma clone of this sheet. using
range( a ).value = range( b).value '(pseudo-code)
1 thing I had column with age/weight like this 35/12-11 now its formatted as a date and no fiddling with data types can recover it.
HOW CAN I STOOP eXCEL DOING THIS KIND OF MADNESS?
next thing the text i.e. names of people in a general column show up as 0 in the destination column. Why? it is coming from a clone of the one its always come form without a problem.
Can anyone shed light on this. it's devastaing trying to write a olution up agianst this kind of thing, but I''ve already invetsed a lot in it.
Any help gladly accepted
You can try something like this. Just don't forget to declare your variables. This also assumes that Row A is where your information is
With shttocopy
'finds last row with information
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'finds last column with information
LastColumn = .cells(LastRow , .Columns.Count).End(xlLeft).Row
'copies cells with information regarding the customer information
'pastes those copied cells into the sheet you want the information moved to
.Range(LastRow:LastColumn).Copy _
destSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1)
end with

Run VBA format code on all sheets with different number of rows

VBA noob here needs a little bit of assistance. I cannot seem to find a solution or get something to work.
I've tried to simplify it as much as I could to get a proof of concept.
The basic idea is to format one cell (A1 say) with all borders, copy that format down across all data in the first sheet (A1:C10 for example), then do the same with data in subsequent sheets. What I'm struggling with is that subsequent sheets all have a different number of rows and anything I try just formats the additional sheets to the (A1:C10) of the original even if there is no data present.
Any help would be greatly appreciated.
What you need is a variable that identifies the last row of any given sheet. For instance
LastRow = Worksheets("Sheet1").cells(65000,1).end(xlup).row
Now you can loop through your cells
for i = 1 to LastRow
for j = 1 to 3
Worksheets("Sheet1").cells(i, j) (apply your formatting)
next j
next i
You can find the last row in a column by using this VBA code:
lastrow = Sheets("SheetName").Cells(rows.count,columnnumber).end(xlup).row
Change columnnumber to the number of the column you are looking in, for example column A = 1.

Selecting all data from a default table size VBA Excel

I have a spread sheet with a default table size and layout that is populated by information from another spread sheet. This table will always have the same number of columns, but the number of entries in the rows can vary. I want to select all the data from the table, and paste it into another sheet, without copying any empty rows.
My initial attempt involved the following code:
Set rightcell = Range("B9").End(x1Right)
Set bottomcell = Range(rightcell).End(x1Down)
To define what the bottom right corner should be, so I can reference the entire table like so:
Range("B9", bottomcell).Select
Or copy or whatever. When I run this, it gives me a "user-defined or object-defined error" and I don't know why. I have the code entered as part of a larger sub, and I have defined my variables as both ranges and variants to try and get this to work. I have spent quite a bit of time scouring the internet for a solution, but so far the information I've found has not explicitly related to my problem, and none of the similar solutions work.
Does anyone know what the appropriate coding for this is, or if I am making some minor error that is throwing everything else off? I remember encountering the same issue during a project in college, but for the life of me, I can't recall the solution. It's quite frustrating.
Also, if I am too vague or you need more clarification on the task, don't hesitate to ask. Thanks in advance for the help!
EDIT: An important note that I left out is that the the table I want to extract data from is in the middle of a page with multiple other tables that I am not trying to interact with.
If the table will always be in the same location on the sheet, you can do something like this to copy the entire table:
'Modify this to any cell in your table (like the top left hand cell):
Range("B9").CurrentRegion.Copy Sheets("TheSheetYouWantToPasteTo").Range("A1")
Even if the table's location on the sheet changes, you can still use the above code to copy the table as long as you know one of the cells in the table.
If you want to keep the same method as you're trying, try this instead:
Dim rightcell As Long
Dim bottomcell As Long
'Finds the furthest column to the right:
rightcell = Cells(5, Columns.Count).End(xlToLeft).Column
'Finds the bottom most row in the table (will stop at the first non-blank cell it finds.)
bottomcell = Range("B:B").Find("*", Range("B9"), searchdirection:=xlPrevious).Row
'Reference the variables like this:
Range(Cells(9, 2), Cells(bottomcell, rightcell)).copy _
Sheets("TheSheetYouWantToPasteTo").Range("A1")
this is what I use
Public Function last_row() As Long
Dim i As Integer
Dim l_row As Long
'my sheet has 35 columns change this number to fit your
For i = 1 To 35
If Sheet1.Cells(Rows.Count, i).End(xlUp).Row > l_row Then
l_row = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
last_row = l_row
End Function
Then Use
Dim l_row As Long
l_row = last_row
'Again since you know the last column change 35 here to your value
'or use the String i.e. "AI"
Range("B9", Cells(l_row,35)).Select
This will look at every column to determine the the last row that contains data